遅いvlookupとcountifs

Question

私は、同じ日、週、時間を持つレジスタの数をカウントし、その数を同じ週を見つけることのできる年数で割ってテーブルを埋めようとしています。

私はVBAでこのコードを実行しましたが、実際には速度が遅いので、このソリューションを改善する手助けができたら、本当に感謝します。

Sub formulacion() 
    Dim a As Integer 
    Dim b As Integer 
    Dim years As Integer 
    Dim rango_semana As Range 
    Dim rango_dia As Range 
    Dim rango_hora As Range 
    Dim rango_sede As Range 
    Dim rango_busqueda As Range 



    a = 2 
    For a = 2 To 319 
     If Sheets("Dinamicos").Cells(5, a) <> "" Then 
     b = 6 
      For b = 6 To 20 

      semana = Sheets("Dinamicos").Cells(3, a) 
      dia = Sheets("Dinamicos").Cells(5, a) 
      hora = Sheets("Dinamicos").Cells(b, 1) 
      sede = Sheets("Dinamicos").Cells(4, 1) 
      LastRow = Sheets("Base").Cells(Sheets("Base").Rows.Count, "A").End(xlUp).Row 
      Set rango_semana = Sheets("Base").Range("AK2:AK" & LastRow) 
      Set rango_dia = Sheets("Base").Range("AG2:AG" & LastRow) 
      Set rango_hora = Sheets("Base").Range("AJ2:AJ" & LastRow) 
      Set rango_sede = Sheets("Base").Range("J2:J" & LastRow) 
      Set rango_busqueda = Sheets("Base").Range("AK2:AN" & LastRow) 

      lookupvalue = Application.VLookup(semana, rango_busqueda, 4, False) 
       If IsError(lookupvalue) Then 
       years = 1 
       'Si lo encuentra lo devuelve 
       Else 
       years = lookupvalue 
       End If 

      Sheets("Dinamicos").Cells(b, a) = (WorksheetFunction.CountIfs(rango_semana, semana, rango_dia, dia, rango_hora, hora, rango_sede, sede))/years 

      Next b 
     End If 
     b = 6 
    Next a 


    End Sub 

Answer 1

入れ子のFor ... Nextループ反復では、いくつかのvar割り当てが変更されます。他の人はそうしない。変更されないヴァースを再割り当てしないでください。

Application.Matchは、Application.Vlookupよりも高速です。

値をaおよびbに設定してリセットする必要はありません。ループおよびネストループでこれらを使用する前に設定してください。ループに入ると、開始値が割り当てられます。

lastRow = Worksheets("Base").Cells(Worksheets("Base").Rows.Count, "A").End(xlUp).Row 
Set rango_semana = Worksheets("Base").Range("AK2:AK" & lastRow) 
Set rango_dia = Worksheets("Base").Range("AG2:AG" & lastRow) 
Set rango_hora = Worksheets("Base").Range("AJ2:AJ" & lastRow) 
Set rango_sede = Worksheets("Base").Range("J2:J" & lastRow) 
Set rango_busqueda = Worksheets("Base").Range("AK2:AN" & lastRow) 
sede = Worksheets("Dinamicos").Cells(4, 1) 

For a = 2 To 319 
    If Worksheets("Dinamicos").Cells(5, a) <> "" Then 
     semana = Worksheets("Dinamicos").Cells(3, a) 
     dia = Worksheets("Dinamicos").Cells(5, a) 

     For b = 6 To 20 

      hora = Sheets("Dinamicos").Cells(b, 1) 

      lookupvalue = Application.Match(semana, rango_busqueda.Columns(1), False) 
      If IsError(lookupvalue) Then 
       years = 1 
       'Si lo encuentra lo devuelve 
      Else 
       years = rango_busqueda.Cells(lookupvalue, 4).Value2 
      End If 

      Worksheets("Dinamicos").Cells(b, a) = (WorksheetFunction.CountIfs(rango_semana, semana, rango_dia, dia, rango_hora, hora, rango_sede, sede))/years 

     Next b 
    End If 
Next a 

最後に、シートはワークシートと同じではないことに注意してください。