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

我正在使用excelvba。我需要创建一个启动用户表单的宏按钮。用户表单将要求3个参数。“工作表名称”、“国家数量”和“顺序”（前两个输入将在文本框中给出，但“顺序”将来自组合框）。宏应在工作簿中创建一个新的工作表，命名为用户输入的“工作表名称”。此工作簿中有一个名为“国家”的现有工作表，其中列出了一些国家，从单元格A2开始，一直到a列。具体取决于“国家数”的输入，此宏应从现有列表中复制该数量的国家，并将其粘贴到新创建的工作表中。最后，如果用户选择“反向”作为“顺序”的输入，列表应该翻转

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

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

这一切都应该通过将这些列表作为数组来完成

现在，我有一个名为CreateList的用户表单。它有一个名为SheetText和NumRows的文本框，以及一个名为OrderList的组合框（我希望在选项中使用“普通”和“反向”）

userform连接到以下代码

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

这里有很多问题。首先，“正常”和“反向”在用户表单的组合框中甚至不会显示为选项。此外，我也不知道该怎么做，扭转名单。比如，如果OrderList.Value=Reverse，那么。当我尝试仅使用前两个输入运行此程序时，我会收到关于“Dim Countries（NumRows）As Integer”行的错误消息“constant expression required”（需要常量表达式）（我也尝试过将Dim Countries（NumRows）设置为字符串，但没有效果）。

用于填充组合框

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

子国家粘贴（SheetText为字符串，NumRows为长，OrderList为字符串）
Dim国家（）
暗行与长行相同，最后一行与长行相同
将Sht变暗为工作表
将wb设置为工作簿
设置wb=ThisWorkbook
设置Sht=wb.工作表（“国家”）
'命名语法：1。您可以使用所有字母数字字符，但不能使用以下特殊字符：\，/，*，？，：，[ , ]
SheetText=CleanSheetName（SheetText）
'命名语法：2。工作表名称不能超过31个字符。
如果Len（SheetText）>31，则MsgBox“工作表名称不能超过31个字符。”：退出Sub
命名语法：3。该名称在单个工作簿中必须是唯一的。
如果WSE存在（SheetText，wb），则MsgBox“工作表”&SheetText&“Allready存在”：退出Sub-Else wb.Sheets.Add（在：=wb.Sheets（wb.Sheets.Count）之后）。Name=SheetText
'LastRow=Sht.Cells（Sht.Rows.Count，“A”）.End（xlUp.Row
国家/地区=短期范围（“A2:A”和NumRows+2）”最后一行
如果OrderList=“Reverse”，则
Countries=ReverseArray（国家，True）
”“否则呢
'Countries=ReverseArray（国家）
如果结束
wb.Sheets（SheetText）.Range（“A3”）.Resize（NumRows）=Application.Transpose（国家）”将值放入新的工作表
端接头
函数wsExists（wsName为字符串，wb为工作簿）为布尔值
昏暗的天气
对于wb.Sheets中的每个ws
wsExists=（wsName=ws.Name）：如果wsExists存在，则退出函数
下一个ws
端函数
函数CleanSheetName（strIn作为字符串）作为字符串
作为对象的Dim objRegex
设置objRegex=CreateObject（“vbscript.regexp”）
用objRegex
.Global=True
.Pattern=“[\[\]\*\\\/\？\：]”
CleanSheetName=.Replace（strIn，“”）将禁止字符更改为空
以
端函数
函数反转array（arr为变量，可选rev为Boolean=False）为变量
Dim-val作为变体
使用CreateObject（“System.Collections.ArrayList”）'
当我尝试仅使用前两个输入运行此程序时，我会收到关于“Dim Countries（NumRows）As Integer”行的错误消息“constant expression required”（我也尝试过将其作为字符串调暗，但没有效果）

出现此错误是因为无法在运行时定义包含多个元素的数组。如果需要动态数组，请使用以下命令：

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

这会让你更容易；​唯一的问题是，如果用户选择“反向”，则会占用原始列表的末尾。我希望它只取列表的第一个NumRows行，并反转该数组，如我的示例所示。