オートフィルタモードの最適化

Question

私はこのVBAを書いています。しかし、大部分の値は自分自身で何度も繰り返されています。以下のコードをループに変換できるかどうかは疑問です。確かにこれは何らかの方法で最適化することができますが、特に "オートフィルタ"が1つの "フィールド"を持つことができるかどうかを確認するのは苦労しています。何か案が？

With Sheets(7) 
     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=14, Criteria1:="america" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(18, 2) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=14, Criteria1:="asia" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(19, 2) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=14, Criteria1:="europe" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(20, 2) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=14, Criteria1:="africa" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(21, 2) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=15, Criteria1:="america" 
     .Range("A:E").AutoFilter Field:=12, Criteria1:="red" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(18, 3) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=15, Criteria1:="asia" 
     .Range("A:E").AutoFilter Field:=12, Criteria1:="green" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(19, 3) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=15, Criteria1:="europe" 
     .Range("A:E").AutoFilter Field:=12, Criteria1:="yellow" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(20, 3) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=15, Criteria1:="africa" 
     .Range("A:E").AutoFilter Field:=12, Criteria1:="dark red" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(21, 3) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=17, Criteria1:="america" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(18, 5) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=17, Criteria1:="asia" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(19, 5) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=17, Criteria1:="europe" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(20, 5) = j 

     .AutoFilterMode = False 
     .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
     .Range("A:E").AutoFilter Field:=17, Criteria1:="africa" 
     j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
     Sheets(15).Cells(21, 5) = j 

     .AutoFilterMode = False 
End With 

Answer 1

それって単にいくつかの基準と行数をカウントするためAutoFilterのExcel.WorksheetFunction.CountIfs isteadを使用するように速くなります。これにより

.AutoFilterMode = False 
    .Range("A:E").AutoFilter Field:=1, Criteria1:="=*apple" 
    .Range("A:E").AutoFilter Field:=14, Criteria1:="america" 
    j = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 
    Sheets(15).Cells(18, 2) = j 

：あなたはこの交換できるように

Sheets(15).Cells(18, 2) = Excel.WorksheetFunction.CountIfs(Sheets(7).Columns(1), "=*apple", Sheets(7).Columns(14), "america") 

を、あなたはイースリーであなたのコードを置き換えることができます：ループを考え作成するため

With Sheets(7) 
    Sheets(15).Cells(18, 2) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(14), "america") 
    Sheets(15).Cells(19, 2) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(14), "asia") 
    Sheets(15).Cells(20, 2) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(14), "europe") 
    Sheets(15).Cells(21, 2) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(14), "africa") 
    Sheets(15).Cells(18, 3) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(15), "america", .Columns(12), "red") 
    Sheets(15).Cells(19, 3) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(15), "asia", .Columns(12), "green") 
    Sheets(15).Cells(20, 3) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(15), "europe", .Columns(12), "yellow") 
    Sheets(15).Cells(21, 3) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(15), "africa", .Columns(12), "dark red") 
    Sheets(15).Cells(18, 5) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(17), "america") 
    Sheets(15).Cells(19, 5) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(17), "asia") 
    Sheets(15).Cells(20, 5) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(17), "europe") 
    Sheets(15).Cells(21, 5) = Excel.WorksheetFunction.CountIfs(.Columns(1), "=*apple", .Columns(17), "africa") 
End With 

それは、この時点で、いいのよあなたの条件が不規則であるという事実によれば、厄介である。私はあなたのためにこれをスピードアップする前に

cols = Array(2, 3, 5) 
contin = Array("america", "asia", "europe", "africa") 
colour = Array("red", "green", "yellow", "dark red") 

For Each k In cols 
    For i = 0 To 3 
     If k <> 3 Then Sheets(15).Cells(i + 18, k) = Excel.WorksheetFunction.CountIfs(Sheets(7).Columns(1), "=*apple", Sheets(7).Columns(12 + k), contin(i)) 
     If k = 3 Then Sheets(15).Cells(i + 18, k) = Excel.WorksheetFunction.CountIfs(Sheets(7).Columns(1), "=*apple", Sheets(7).Columns(12 + k), contin(i), Sheets(7).Columns(12), colour(i)) 
    Next i 
Next k