VBA过滤循环中循环

Question

我发现了这段代码，它只是为一列找到所有唯一的值，并过滤它们，复制/粘贴在过滤值命名为sheet。

但是我需要做的是过滤两列，并按照相同的原则命名，所以我修改了它。

对于第一个循环中的第二个值，它不会在另一个循环中启动循环。

为什么它在第二个循环中给我空白?

Sub datu_sagrupesana()
Dim x As Range, y As Range, rng As Range, last As Long, sht As Worksheet
Application.ScreenUpdating = False

'datu vieta
Set sht = ThisWorkbook.Worksheets("Test")
'apgabals
last = sht.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A1:C" & last)
sht.Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True 'produkta filtrs
sht.Range("C1:C" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True 'valodas filtrs
For Each y In Range([J2], Cells(Rows.Count, "J").End(xlUp))
For Each x In Range([H2], Cells(Rows.Count, "H").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=3, Criteria1:=y.Value
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = y.Value & x.Value
ActiveSheet.Paste
End With
Next x
Next y

'nonemt filtru
sht.AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub

Answer 1

自己解决

Sub datu_sagrupesana()
Dim x As Long, y As Range, rng As Range, last As Long, sht As Worksheet
Application.ScreenUpdating = False

'datu vieta
Set sht = ThisWorkbook.Worksheets("Test")
'apgabals
last = sht.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sht.Range("A1:C" & last)
sht.Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True 'produkta filtrs
sht.Range("C1:C" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I1"), Unique:=True 'valodas filtrs
pr = Application.WorksheetFunction.CountA(sht.Columns("H"))
va = Application.WorksheetFunction.CountA(sht.Columns("I"))
For j = 2 To va
For i = 2 To pr
valoda = sht.Cells(j, "I").Value
produkts = sht.Cells(i, "H").Value

'
'For Each y In Range("J2", Cells(Rows.Count, "J").End(xlUp))
'
'
'For Each x In Range("H2", Cells(Rows.Count, "H").End(xlUp))
'
With rng
.AutoFilter
.AutoFilter Field:=3, Criteria1:=valoda
.AutoFilter Field:=1, Criteria1:=produkts
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = valoda & produkts
ActiveSheet.Paste
End With
'
'Next x
'Next y
Next i
Next j

'nonemt filtru
sht.AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub