VBA基于两列值排序

时间:2017-04-26 19:10:04

标签: vba excel-vba excel

首先让我说我已经搜索了互联网和这个网站的解决方案并且无济于事。在遵循网站规则时,我尝试开发代码来解决我的问题,并可以向社区提供示例以寻求建议或帮助。

目标: 我希望使用两个值列表(每个列在它们自己的列中,例如列I& J)作为自动过滤器类别。我希望VBA脚本选择第一列中的第一个值并过滤我的表,然后获取第J列中的第一个值并再次过滤表。然后,代码将执行命令,重置并重新启动过滤器进程。这一次,我希望脚本再次选择第一列中的第一个值并过滤表,然后选择第J列中的第二个值并过滤。整个过程应该重复,直到列J中的所有值都已执行,过滤器应该重置,在列I中选择第二个值,然后重新启动第J列的第一个值。

我可以使用以下代码按照第I列中的值过滤我的表:

Set Rng = ws3.Range("i2:i" & ws3.Cells(Rows.Count, "i").End(xlUp).Row) Rng.Sort Key1:=ws3.Range("I1"), Order1:=xlAscending

然而,我无法调整代码以按照正确的排序顺序考虑我的第二列过滤器值列表中的逻辑

Set Rng = ws3.Range("j2:j" & ws3.Cells(Rows.Count, "i").End(xlUp).Row) Rng.Sort Key1:=ws3.Range("j1"), Order1:=xlAscending

有没有办法按照上面的目标将步骤链接在一起?

这是我的完整脚本:

选项明确

Sub Loop2()
Dim cell As Range 'loop range
Dim Rng As Range 'range for unique values

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim lRow As Long 'last row in Inspection sheet
Dim i As Integer 'counter

Set ws1 = Worksheets("Data")
Set ws2 = Worksheets("Inspection")
Set ws3 = Worksheets("NamedRange")

Application.ScreenUpdating = False

'reset autofilter
ws1.ListObjects("Table3").Range.AutoFilter

'autofilter on Inspection selected
ws1.ListObjects("Table3").Range.AutoFilter Field:=1, Criteria1:=ws2.Range("C3")

'copy Column B in Table3 to NamedRange!I1
ws1.Range("B6:B20").SpecialCells(xlVisible).Copy 'extend range when needed
ws3.Range("I1").PasteSpecial

'Remove duplicates for unique values
ws3.Columns("I:I").RemoveDuplicates Columns:=1, Header:=xlYes

'set range for loop and sort
Set Rng = ws3.Range("i2:i" & ws3.Cells(Rows.Count, "i").End(xlUp).Row)
Rng.Sort Key1:=ws3.Range("I1"), Order1:=xlAscending

lRow = 6 'set current last row for start of ws3 summary sheet

'loop to copy row 3 from ws1 to ws2

For Each cell In Rng

    'increment last row
    i = i + 1

    With ws1
        .ListObjects("Table3").Range.AutoFilter Field:=2, Criteria1:=cell.Value
        .Range("B3:E3").Copy
        ws2.Range("B" & lRow + i).PasteSpecial xlPasteValues
    End With

Next

'goto ws2.Range
Application.Goto ws2.Range("B6")

Application.ScreenUpdating = True

End Sub

0 个答案:

没有答案