创建一个用户表单,将其复制并粘贴到新表中

时间:2019-04-05 05:51:14

标签: excel vba userform

我正在使用Excel VBA。我需要创建一个宏按钮来启动用户表单。用户表单将要求3个参数。 “工作表名称”,“国家数”和“订单”(前两个输入将在文本框中给出,但“订单”将来自组合框)。该宏应在工作簿中创建一个新的工作表,命名为用户为“工作表名称”输入的名称。该工作簿中已有一个名为“国家”的工作表,其中列出了一些国家,这些国家从A2单元格开始,一直到A列下。根据“国家数量”的输入,此宏应从现有的国家中复制该国家列表,然后将它们粘贴到新创建的工作表上。最后,如果用户选择“反向”作为其“订单”的输入,则该列表应被翻转。

例如,打开宏,输入“ New Stuff”,“ 5”,然后选择“ Reverse”。单击“确定”后,Excel应该在粘贴的地方创建一个新的工作表:

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

应该全部将这些列表视为数组。

现在,我有一个名为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

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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

  

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

由于无法在运行时定义包含多个元素的数组,因此引发此错误。如果您想使用动态数组,请执行以下操作:

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