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

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

步骤1：在“标准”工作表中，有三列，每行包含特定的数据组合。第一组组合是“美元，汽车”

步骤2：然后宏将移动到输出工作表（请参阅下面的链接获取屏幕截图），然后使用“标准”工作表中的第一组标准“USD”和“Car”过滤A列和B列

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

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

步骤5：然后宏将移回“标准”工作表，并继续基于第二组组合“USD，Plane”过滤“输出”工作表中的数据。同样，它将根据“标准”工作表中的“集合数”复制过滤后的数据。此过程将继续，直到“标准”工作表中的所有不同组合都已处理完毕

---

好的，很抱歉耽搁了，这里有一个工作版本

您只需添加一张名为“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

---

谢谢你的回复。我刚刚尝试了您的代码，但它在“ColLet”上返回了一个“编译错误：未定义子或函数”。代码中缺少一个函数吗？我的朋友，我忘了加入我经常使用的那个函数，我会尽快更正，我在电脑上我做了一些研究，这个函数似乎可以与您的代码一起工作：函数ColLet（x为整数）作为字符串与ActiveSheet。Columns（x）ColLet=Left（.Address（False，False），InStr（.Address（False，False），“：”）-1）以End函数结尾看起来确实是相同的目的，但我必须承认我的比这更脏！^如果它工作正常，请让我知道，我将更改并将其添加到我的答案中！若你们的第一个问题得到了回答，请验证答案以关闭主题！；）但在“定义集合的编号和粘贴N次”部分，我还有一个问题。假设我有另一个工作簿，其中“标准”表中的“集合数”列现在位于D列，而不是C列。此外，在“输出”表中，“货币”列和“产品”列现在分别位于B列和AR列。“Set”列现在位于列AU中，列A、C-AQ、AS-AT中的所有其他列都用其他数据填充。如何更改“定义集合编号和粘贴N次”的代码以适应这种情况？