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

循环中的VBA过滤循环

1 个答案: