Question

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

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

Criteria worksheet

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

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

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

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

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

根据另一个工作表上的条件多次复制一组数据

1 个答案: