With Range("A:A")
    .Replace "@Дрова", "[lumber]", 2
End With

    For b = 1 To 2
        
            Select Case b
                 Case 1
                      rnge = "A1:A30"
                 Case 2
                      rnge = "B1:B30"
            End Select
            
            q(b) = Range(rnge).Value
    Next b

Cells(35 + j, 2).Value = Format(j, "'00.") & Format(Z, "00") & ".24"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell.Calculate
End Sub

for i = 1 to LR
 a(i) = Sheets("DB").Range("A" & i).Value
next i

dim baseArray(), LR&

LR = Sheets("DB").Cells(Rows.Count, 2).End(xlUp).Row

redim baseArray(1 to LR)

For i = 1 To ubound(baseArray)
    baseArray(i) = Sheets("DB").Range(Cells(i, 2), Cells(i, 4))
Next i

for i = 1 to LR
 a(i) = Sheets("DB").Range("A" & i).Value
next i

Sub dollar()

Dim textHTTP As Object
Dim URL, Txt, Kurs As String
Dim posUSD, k As String

URL = "https://www.cbr.ru"
Set textHTTP = CreateObject("MSXML2.XMLHTTP")

textHTTP.Open "GET", URL, False
textHTTP.Send
'Ждем загрузку сайта статус 200
If textHTTP.Status = 200 Then
'Получаем текст сайта в переменной txt
    Txt = textHTTP.responseText
'Находим позицию строки USD
    posUSD = InStr(1, Txt, "USD")
    k = InStr(posUSD, Txt, "right mono-num")
    Kurs = Mid(Txt, k + 16, 8)
    MsgBox "Куср доллара ЦБ: " & Kurs
Else
    MsgBox "Нет отклика с сайта"
End If
Set textHTTP = Nothing

End Sub

=ИНДЕКС(A:L;СУММ(ЕСЛИ(C2:L9=ДЕНЬ(СЕГОДНЯ());СТРОКА(C2:L9)))+1;СУММ(ЕСЛИ(C2:L9=ДЕНЬ(СЕГОДНЯ());СТОЛБЕЦ(C2:L9))))

=СУММЕСЛИ(C2:L8;ДЕНЬ(СЕГОДНЯ());C3:L9)

    Dim dic As Object    Set dic = CreateObject("Scripting.Dictionary")
 
    Dim a As Range
    For Each a In Range("A1:C1")
        If a <> 0 Then dic.Item(a.Address(0, 0)) = 0
    Next
    Dim v As Variant
    For Each v In dic.Keys
        Set a = Range(v)
        'Ваши действия
        Debug.Print a.Value
    Next

    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set dic3 = CreateObject("Scripting.Dictionary")
    Set dic4 = CreateObject("Scripting.Dictionary")
    Set dic5 = CreateObject("Scripting.Dictionary")
......
For Each a In Range("A1:C1")
        If a <> 0 Then dic1.Item(a.Address(0, 0)) = 0
    Next
        For Each b In Range("A2:C2")
            If b <> 0 Then dic2.Item(b.Address(0, 0)) = 0
        Next
            For Each c In Range("A3:C3")
                If c <> 0 Then dic3.Item(c.Address(0, 0)) = 0
            Next
                For Each d In Range("A4:C4")
                    If d <> 0 Then dic4.Item(d.Address(0, 0)) = 0
                Next
                    For Each e In Range("A5:C5")
                        If e <> 0 Then dic5.Item(e.Address(0, 0)) = 0
                    Next
.......
    For Each v1 In dic1.Keys
        Set a = Range(v1)
            For Each v2 In dic2.Keys
                Set b = Range(v2)
                    For Each v3 In dic3.Keys
                        Set c = Range(v3)
                            For Each v4 In dic4.Keys
                                Set d = Range(v4)
                                    For Each v5 In dic5.Keys
                                        Set e = Range(v5)

...... Здесь требуемые расчеты и результат

Next:Next:Next:Next:Next:Next:Next........

For Each a in Range ("A1:C1")
If a = 0 then ....
Next

For Each a in Range ("A1:C1")
For Each b in Range ("A2:C1")

Next:Next