VBA在循環中過濾循環

Question

我發現這個代碼，它只有一列找到所有的唯一值，並過濾它們，複製/粘貼過濾值名爲表。

但我需要做的是過濾兩列，並用相同的原則命名，所以我修改了它。

不知何故第一個循環中的第二個值，它不會在其他循環中啓動循環。

爲什麼它會在第二個循環中給我空白？

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