在工作表列 VBA 中查找数组值

Question

我是 VBA 的新手，我一直在尝试让我的宏运行一个数组中的名称列表，并根据该名称创建一个新的 WS。然后让我的宏运行组号列表，看看是否可以在工作表列中找到它们。如果找到它们，我需要主工作表“DataSource”按组号过滤并将过滤后的数据粘贴到新创建的工作表中。如果这没有得到很好的解释，我深表歉意。 到目前为止，我已经能够创建新的工作表，但是当我尝试过滤第二个组号数组时，我收到错误“类型不匹配”（参考 ln 41）。我也在纠结如何将过滤后的数据粘贴到他们指定的工作表中，而不必为每个 WS 声明一个变量名。请帮忙！

Sub Loops()

'Declare Variant Array for Sheet Names
Dim WSNames(1 To 3) As String
WSNames(1) = "NA"
WSNames(2) = "EU"
WSNames(3) = "APAC"

'Declare Variant to Hold Array Elements
Dim item As Variant

'Loop through entire array

For Each item In WSNames
'create a new worksheet using the sheet names in array
    Sheets.Add(After:=Sheets("DataSource")).Name = item
Next item

'Set Variables for Data WS
Dim DataWS As Worksheet
Dim GrpRge As Range
Dim DataRge As Range

Set DataWS = Worksheets("DataSource")
Set GrpRge = DataWS.Range("G2").EntireColumn


'Declare Variant Array for Group Numbers

Dim GrpNumbers(1 To 3) As Integer
GrpNumbers(1) = Array(18522, 20667)
GrpNumbers(2) = 18509
GrpNumbers(3)= 56788


'Declare Integer to Hold Array Elements
Dim i As Variant

'Filter Data Worksheets to Create Pivot Tables
For Each i In CCNumbers
    If i = GrpRge.Value Then Worksheets("DataSource").Range("G2").AutoFilter Field:=7, Criteria1:=i
    Set DataRge = Worksheets("DataSource").Range("As").CurrentRegion
    Worksheets("DataSource").Activate
    DataRge.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    WSNames.Range("A1").PasteSpecial Paste:=xlPasteAll
        Next i

End Sub

Tried Creating a For Loop but it won't run correctly.

Answer 1

导出数据组

前

后

代码

Option Explicit

Sub ExportGroups()

    ' Populate a String array with the worksheet names.
    Dim wsNames(1 To 3) As String
    wsNames(1) = "NA"
    wsNames(2) = "EU"
    wsNames(3) = "APAC"

    ' Populate a Variant array with the group numbers.
    Dim grpNumbers(1 To 3) As Variant
    grpNumbers(1) = Array("18522", "20667") ' use strings here!!!
    grpNumbers(2) = 18509
    grpNumbers(3) = 56788
    
    ' Turn off settings.
    Application.ScreenUpdating = False
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Ensure the workbook is active because cells are being selected
    ' later in the code (e.g. 'dfCell.Select').
    If Not wb Is ActiveWorkbook Then wb.Activate
    
    ' Reference the Source worksheet, the one read (copied) from.
    Dim sws As Worksheet: Set sws = wb.Worksheets("DataSource")
    ' Turn off AutoFilter.
    If sws.AutoFilterMode Then sws.AutoFilterMode = False
    ' Reference the Source range.
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    
    ' Declare additional variables.
    Dim dws As Worksheet ' Destination Worksheet (the one written (pasted) to)
    Dim dfCell As Range
    Dim n As Long ' Counter (For...Next Control Variable)

    ' Loop through the elements of the arrays.
    For n = UBound(wsNames) To LBound(wsNames) Step -1
    ' or:
    'For n = UBound(grpNumbers) To LBound(grpNumbers) Step -1
        ' Add a new worksheet (after the source worksheet)...
        Set dws = wb.Worksheets.Add(After:=sws)
        ' ... and rename it using the current name from the names array.
        dws.Name = wsNames(n)
        If IsArray(grpNumbers(n)) Then ' multiple group numbers (in an array)
            srg.AutoFilter 7, grpNumbers(n), xlFilterValues
        Else ' a single group number
            srg.AutoFilter 7, grpNumbers(n) ', 'xlAnd' is default (irrelevant)
        End If
        ' Reference the first destination cell.
        Set dfCell = dws.Range("A1")
        ' Copy column widths using the source's header row.
        srg.Rows(1).Copy
        dfCell.PasteSpecial xlPasteColumnWidths
        ' Select the first cell since now the selection is the first row,
        ' a by-product of 'PasteSpecial'.
        dfCell.Select
        ' Copy the visible range.
        srg.SpecialCells(xlCellTypeVisible).Copy dfCell
        ' Clear the filter.
        sws.ShowAllData
    Next n
    
    ' Turn off AutoFilter (out-comment to keep the auto filter arrows).
    sws.AutoFilterMode = False
    
    ' Select the first source cell.
    Application.Goto srg.Cells(1) ' includes activating the worksheet

    ' Turn on settings.
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Data groups exported.", vbInformation

End Sub