根据另一张纸上的条件多次复制一组数据

Question

Excel 2010。我正在尝试编写一个宏，该宏可以根据另一张纸上的条件多次复制一组数据，但我已经卡了很长时间。我非常感谢任何可以帮助我解决这个问题的帮助。

第 1 步：在“条件”工作表中，有三列，每行包含特定的数据组合。第一组组合是“USD, Car”。

Criteria worksheet

第 2 步：然后宏将移动到输出工作表（请参阅下面的屏幕截图链接），然后在“条件”中使用第一组条件“美元”和“汽车”过滤 A 列和 B 列" 工作表。

第 3 步：之后，宏会将过滤后的数据复制到最后一个空白行。但这里棘手的是，过滤后的数据必须复制两次（因为“条件”选项卡中的“集合数”列在此组合中为 3，并且不必复制数据三次因为过滤后的数据将被视为第一组数据）

Step4：过滤后的数据复制完成后，“集合”列D需要填写相应行所在的集合数。因此，在第一个示例中，单元格D2和D8将具有“1 " 值，单元格 D14-15 的值为“2”，单元格 D16-17 的值为“3”。

Step5：然后宏将移回“Criteria”工作表并继续基于第二组组合“USD，Plane”来过滤“Output”工作表中的数据。同样，它将根据“标准”工作表中的“集合数”复制过滤后的数据。此过程将继续进行，直到处理完“条件”工作表中的所有不同组合。

Output worksheet

Answer 1

抱歉耽搁了，这是一个工作版本

您只需要添加一个名为“BF”的工作表，因为自动筛选计数无法正常工作，所以我不得不使用另一个工作表

Sub testfct()
Dim ShC As Worksheet
Set ShC = ThisWorkbook.Sheets("Criteria")
Dim EndRow As Integer
EndRow = ShC.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To EndRow
        Get_Filtered ShC.Cells(i, 1), ShC.Cells(i, 2), ShC.Cells(i, 3)
    Next i

End Sub

Sub Get_Filtered(ByVal FilterF1 As String, ByVal FilterF2 As String, ByVal NumberSetsDisered As Integer)
Dim NbSet As Integer
NbSet = 0
Dim ShF As Worksheet
Set ShF = ThisWorkbook.Sheets("Output")

Dim ColCr1 As Integer
Dim ColCr2 As Integer
Dim ColRef As Integer

ColCr1 = 1
ColCr2 = 2
ColRef = 4

If ShF.AutoFilterMode = True Then ShF.AutoFilterMode = False

Dim RgTotal As String
RgTotal = "$A$1:$" & ColLet(ShF.Cells(1, Columns.Count).End(xlToLeft).Column) & "$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row

ShF.Range(RgTotal).AutoFilter field:=ColCr1, Criteria1:=FilterF1
ShF.Range(RgTotal).AutoFilter field:=ColCr2, Criteria1:=FilterF2
'Erase Header value, fix? or correct at the end?
ShF.AutoFilter.Range.Columns(ColRef).Value = 1

Sheets("BF").Cells.ClearContents
ShF.AutoFilter.Range.Copy Destination:=Sheets("BF").Cells(1, 1)
Dim RgFilt As String
RgFilt = "$A$2:$B" & Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row '+ 1


Dim VR As Integer
'Here was the main issue, the value I got with autofilter was not correct and I couldn't figure out why....
    'ShF.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
    'Changed it to a buffer sheet to have correct value
VR = Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row - 1


Dim RgDest As String

ShF.AutoFilterMode = False
'Now we need to define Set's number and paste N times
For k = 1 To NumberSetsDisered - 1
    'define number set
    For j = 1 To VR
        ShF.Cells(Rows.Count, 1).End(xlUp).Offset(j, 3) = k + 1
    Next j
    RgDest = "$A$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":$B$" & (ShF.Cells(Rows.Count, 1).End(xlUp).Row + VR)
    Sheets("BF").Range(RgFilt).Copy Destination:=ShF.Range(RgDest)

Next k

ShF.Cells(1, 4) = "Set"
Sheets("BF").Cells.ClearContents
'ShF.AutoFilterMode = False
End Sub

以及使用整数输入获取列字母的函数：

Function ColLet(x As Integer) As String
  With ActiveSheet.Columns(x)

        ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)

    End With
End Function