如何在VBA中循环浏览所有过滤器选项?

问题描述 投票:1回答:1

我想使用循环遍历过滤器中的每个条件,然后计算并输出平均值。我下面的代码计算平均值并将其输出到第二张纸的下一个空白行,但是不幸的是,这仅适用于第一个过滤器选择。在循环的每个新迭代之后,什么都没有发生。谁能帮忙?

source dataoutput

    Option Explicit

Sub avg()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell As Range
Dim lastrow As Long
Dim RowCount As Long
Dim rng1 As Range
Dim nextrow As Long


Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
RowCount = ws2.Cells(Rows.Count, 1).End(xlUp).Row


Set rng1 = ws1.Range("G2:G" & lastrow)

   For Each cell In rng1.SpecialCells(xlCellTypeVisible)

        With ws1.AutoFilter.Range
        ws2.Range("A" & RowCount + 1) = ws1.Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
        ws2.Range("B" & RowCount + 1) = ws1.Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
        End With

            ws2.Range("C" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("Y2:Y" & lastrow & ",Z2:Z" & lastrow & ",AA2:AA" & lastrow _
            & ",AD2:AD" & lastrow & ",AE2:AE" & lastrow & ",AI2:AI" & lastrow & ",AK2:AK" & lastrow & ",AL2:AL" & lastrow).SpecialCells(xlCellTypeVisible))

            ws2.Range("D" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("AF2:AF" & lastrow & ",AM2:AM" & lastrow & ",AP2:AP" & lastrow _
            & ",AQ2:AQ" & lastrow & ",AR2:AR" & lastrow & ",AS2:AS" & lastrow & ",AT2:AT" & lastrow & ",AU2:AU" & lastrow).SpecialCells(xlCellTypeVisible))

            ws2.Range("E" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("AW2:AW" & lastrow & ",AX2:AX" & lastrow & ",AY2:AY" & lastrow).SpecialCells(xlCellTypeVisible))

 Next cell

 End Sub

excel vba autofilter
1个回答
0
投票

您对宏进行的更改很少。请注意,新添加的数组具有过滤条件的唯一值,并且循环从每个单元格更改为数组。 lastrowRowCount变量被lastrow1lastrow2替换。

Sub avg()
Dim wb As Workbook
Set wb = ThisWorkbook

Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng1 As Range, rng1Crt As Range
Dim lastrow1 As Long, lastrow2 As Long, arr As Variant

Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = ws1.Range("G2:G" & lastrow1)

rng1.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng1Crt = rng1.Cells.SpecialCells(xlCellTypeVisible)

'Populating array with filter criteria values
ReDim arr(0 To rng1Crt.Cells.Count - 1)
i = 0
For Each cell In rng1Crt.Cells
arr(i) = cell.Value
i = i + 1
Next

ws1.ShowAllData
rng1.AutoFilter

For i = 1 To UBound(arr)
    lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    rng1.AutoFilter Field:=7, Criteria1:=arr(i)

    With ws1.AutoFilter.Range
    ws2.Range("A" & lastrow2 + 1) = ws1.Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
    ws2.Range("B" & lastrow2 + 1) = ws1.Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
    End With

    ws2.Range("C" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("Y2:Y" & lastrow1 & ",Z2:Z" & lastrow1 & ",AA2:AA" & lastrow1 _
    & ",AD2:AD" & lastrow1 & ",AE2:AE" & lastrow1 & ",AI2:AI" & lastrow1 & ",AK2:AK" & lastrow1 & ",AL2:AL" & lastrow1).SpecialCells(xlCellTypeVisible))

    ws2.Range("D" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("AF2:AF" & lastrow1 & ",AM2:AM" & lastrow1 & ",AP2:AP" & lastrow1 _
    & ",AQ2:AQ" & lastrow1 & ",AR2:AR" & lastrow1 & ",AS2:AS" & lastrow1 & ",AT2:AT" & lastrow1 & ",AU2:AU" & lastrow1).SpecialCells(xlCellTypeVisible))

    ws2.Range("E" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("AW2:AW" & lastrow1 & ",AX2:AX" & lastrow1 & ",AY2:AY" & lastrow1).SpecialCells(xlCellTypeVisible))

Next

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.