创建一个复制并粘贴到新工作表中的用户表单

Question

我正在使用 Excel VBA。我需要创建一个启动用户表单的宏按钮。用户表单将要求 3 个参数。 “工作表名称”、“国家数量”和“顺序”（前 2 个输入将在文本框中给出，但“顺序”将来自组合框）。宏应在工作簿中创建一个新工作表，命名为用户为“工作表名称”输入的任何内容。此工作簿中有一个名为“国家/地区”的现有工作表，其中列出了从单元格 A2 开始的一些国家，并在 A 列继续向下。根据“国家数量”的输入，此宏应从现有的国家/地区复制该数量的国家/地区列表，并将它们粘贴到新创建的工作表上。最后，如果用户选择“Reverse”作为“Order”的输入，列表应该被翻转。

例如...打开宏，输入“New Stuff”、“5”，然后选择“Reverse”。单击“确定”后，Excel 应在粘贴位置创建一个 New Stuff 表：

智利 加拿大 英国 巴西 澳大利亚 阿根廷

所有这些都应该将这些列表视为数组。

现在，我有一个名为 CreateList 的用户表单。它有标题为 SheetText 和 NumRows 的文本框，以及一个标题为 OrderList 的组合框（我希望将“Normal”和“Reverse”作为选项）。

用户窗体连接到以下代码

Private Sub CreateList_Initialize()
    OrderList.AddItem "Normal"
    OrderList.AddItem "Reverse"
    OrderList.ListIndex = 0
End Sub

Private Sub OKButton_Click()
    Call CountrycPasting(SheetText.Value, NumRows.Value, OrderList.Value)
    Unload Me
End Sub

连接到以下代码：

Option Explicit
Sub CountryPasting(SheetText As String, NumRows As Integer, OrderList As String)


    Dim Countries(NumRows) As Integer 'here's what my array should be
    Dim Row As Integer

    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = SheetText

    Worksheets("Countries").Range(A2).Select
    For Row = 1 To NumRows
        Countries(Row) = Selection.Value
        Selection.Offset(1, 0).Select
    Next Row

    Worksheet(SheetText).Range(A3).Select
    For Row = 1 To NumRows
        Selection.Value = Countries(Row)
        Selection.Offset(1, 0).Select
    Next Row

End Sub

Sub Load_Form()
    CreateList.Show
End Sub

这里有一堆问题。首先，“Normal”和“Reverse”甚至不会在用户表单的组合框中显示为选项。另外，我不知道如何处理列表的反转。像，如果 OrderList.Value = Reverse 那么 .... 。当我尝试仅使用前几个输入来运行它时，我收到关于“Dim Country(NumRows) As Integer”行的错误消息“需要常量表达式”（我也尝试过作为字符串调暗，无济于事）。

Answer 1

用于填充组合框

Private Sub CreateList_Initialize()
    With OrderList
        .AddItem "Normal", 0 'add item to top of combobox
        .AddItem "I'm at the bottom!", .ListIndex 'add item to bottom of combobox
        .AddItem "Reverse", 2 'add item to third spot in userform
    End With
End Sub

主要代码

Sub CountryPasting(SheetText As String, NumRows As Long, OrderList As String)
    Dim Countries()
    Dim Row As Long, LastRow As Long
    Dim Sht As Worksheet
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Set Sht = wb.Worksheets("Countries")

    'Naming Syntax: 1. You can use all alphanumeric characters but not the following special characters: \ , / , * , ? , : , [ , ]
        SheetText = CleanSheetName(SheetText)
    'Naming Syntax: 2. A worksheet name cannot exceed 31 characters.
        If Len(SheetText) > 31 Then MsgBox "A worksheet name cannot exceed 31 characters.": Exit Sub
    'Naming Syntax: 3. The name must be unique within a single workbook.
        If wsExists(SheetText, wb) Then MsgBox "Worksheet " & SheetText & " Allready Exist": Exit Sub Else wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = SheetText

        'LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
        Countries = Sht.Range("A2:A" & NumRows+2) 'LastRow)

        If OrderList = "Reverse" Then
            Countries = ReverseArray(Countries, True)
        'Else
            'Countries = ReverseArray(Countries)
        End If
       wb.Sheets(SheetText).Range("A3").Resize(NumRows) = Application.Transpose(Countries) ' put values to new sheet

End Sub

Function wsExists(wsName As String, wb As Workbook) As Boolean
Dim ws
    For Each ws In wb.Sheets
        wsExists = (wsName = ws.Name): If wsExists Then Exit Function
    Next ws
End Function

Function CleanSheetName(strIn As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "[\[\]\*\\\/\?|:]"
        CleanSheetName = .Replace(strIn, "") ' change forbiden characters with nothing
    End With
End Function

Function ReverseArray(arr As Variant, Optional rev As Boolean = False) As Variant
    Dim val As Variant

    With CreateObject("System.Collections.ArrayList") '<-- create a "temporary" array list with late binding
        For Each val In arr '<--| fill arraylist
            .Add val
        Next val
        If rev Then .Reverse '<--| reverse it
        ReverseArray = .Toarray '<--| write it into an array
    End With
End Function

Answer 2

当我尝试仅使用前几个输入来运行它时，我收到关于“Dim countries(NumRows) As Integer”行的错误消息“需要常量表达式”（我尝试将调暗为字符串，同样，无济于事）

出现此错误是因为您无法在运行时定义包含多个元素的数组。如果你想要一个动态数组使用这个：

Dim Countries() As Integer
ReDim Countries(0 to NumRows)