我正在使用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”这一行的错误消息“需要常量表达式”(我也尝试将其调暗为字符串,无济于事。
答案 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)