Медленный vlookup и подсчет
Я пытаюсь заполнить таблицу подсчетом того, сколько у меня регистров, с одним и тем же днем, неделей и часом, и это количество делится на количество лет, в течение которых я могу найти одну и ту же неделю.
Я сделал этот код в 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
1 ответ
Некоторые из назначений var изменяются в рамках вложенных циклов For ... Next; другие нет. Не продолжайте переназначать переменные, которые не меняются.
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
Наконец, помните, что листы - это не то же самое, что листы.