我是 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.
uj5u.com熱心網友回復:
匯出資料組
前

后

編碼
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")
' Clear active filters, if any.
If sws.FilterMode Then sws.ShowAllData
' 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
轉載請註明出處,本文鏈接:https://www.uj5u.com/ruanti/534262.html
標籤:数组擅长VBA循环
