Создание пользовательской формы, которая копирует и вставляет в новый лист

Question

Я использую Excel VBA.Мне нужно создать кнопку макроса, которая запускает форму пользователя.Форма пользователя попросит 3 аргумента.«Имя рабочего листа», «Количество стран» и «Заказ» (первые 2 ввода будут даны в текстовых полях, но «Заказ» будет из поля со списком).Макрос должен создать новый лист в книге, названный независимо от того, что пользователь вводит для «Имя листа».В этой рабочей тетради есть лист под названием «Страны», в котором перечислены некоторые страны, начиная с ячейки А2 и продолжая вниз в колонке А. В зависимости от входных данных для «Количество стран» этот макрос должен копировать это число стран из существующихсписок и вставьте их на вновь созданный лист.Наконец, если пользователь выбирает «Обратный» в качестве своего ввода для «Порядка», список следует перевернуть.

Например ... вы открываете макрос, вводите «Новый материал», «5» ивыберите «Обратный».После нажатия «ОК» 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» (я также попытался затемнить как строку), безрезультатно).

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 Country (NumRows) As Integer» (я пытался затемнить как строку Тоже безрезультатно)

Эта ошибка возникает, потому что вы не можете определить массив с количеством элементов во время выполнения. Если вы хотите динамический массив, используйте это:

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