我想使用循环遍历过滤器中的每个条件,然后计算并输出平均值。我下面的代码计算平均值并将其输出到第二张纸的下一个空白行,但是不幸的是,这仅适用于第一个过滤器选择。在循环的每个新迭代之后,什么都没有发生。谁能帮忙?
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
您对宏进行的更改很少。请注意,新添加的数组具有过滤条件的唯一值,并且循环从每个单元格更改为数组。 lastrow
和RowCount
变量被lastrow1
和lastrow2
替换。
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