'печатаем на лист массив со значениями
ShMapping.Range("N1:N" & ItemList.Count) = PrintOutItems

=суммпроизв(суммеслимн(диапазон суммирования; диапазон критериев; критерий (в виде именнованного диапазона)))

    Dim Table()
    Dim Revised()
    Dim lLastRow  As Long, i As Long, g As Long
        
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Table = Range("A1:I" & lLastRow).Value
    
    For i = 1 To lLastRow
    If Table(i, 8 )<> 0 Then
    For g = 1 To lLastRow
    Revised(g) = Table(i)
    Next g
    End If
    Next i

Sub Тест()
Dim Data()
Dim Result()
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Data = Range("A1:A" & lLastRow)
    
    ReDim Result(1 To lLastRow)
For i = 1 To lLastRow
Result(i) = DatePart("ww", DateValue(Data(i)))
Next i
      End Sub

Dim Qty() As Variant
Dim Price() As Variant
Dim Total() As Variant

     
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

ReDim Qty(1 To lLastRow)
ReDim Price(1 To lLastRow)
ReDim Total(1 To lLastRow)



For i = 2 To lLastRow
Qty(i) = Cells(i, 1)
Next i

For j = 2 To lLastRow
Price(j) = Cells(j, 2)
Next j


For h = 2 To lLastRow
For i = 2 To lLastRow
For j = 2 To lLastRow

Total(h) = Qty(i) * Price(j)

Next j
Next i
Next h

For g = 2 To lLastRow
For h = 2 To lLastRow
Cells(g, 4) = Total(h)
Next h
Next g

Sub Макрос8()
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

If Application.WorksheetFunction.CountIf(Range("Мебель"), Cells(i, 1)) > 0 Then Cells(i, 1) = 1

Next i
End Sub

LastRow = Cells(Rows.Count, 6).End(xlUp).Row
    Application.ScreenUpdating = False
    
    EUR = InputBox("ввести курс евро ЦБ") 'eur=70
    USD = InputBox("ввести курс доллара ЦБ") 'USD=60
    GBP = InputBox("ввести курс фунта ЦБ") 'USD=80
    
    For r = 1 To LastRow 'проверяем евро
    If Cells(r, 6) = "EUR" Then
    If WorksheetFunction.CountIf((Cells(r, 7)), EUR) = 1 Then
    Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 5296274
    Else: Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 255
    End If
    End If
    Next r
    
    For r = 1 To LastRow 'проверяем доллары
    If Cells(r, 6) = "USD" Then
    If WorksheetFunction.CountIf((Cells(r, 7)), USD) = 1 Then
    Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 5296274
   Else: Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 255
    End If
    End If
    Next r
    
 For r = 1 To LastRow 'проверяем фунты
    If Cells(r, 6) = "GBP" Then
    If WorksheetFunction.CountIf((Cells(r, 7)), GBP) = 1 Then
    Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 5296274
   Else: Range(Cells(r, 6), Cells(r, 7)).Interior.Color = 255
    End If
    End If
    Next r

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
N = 1

For r = 1 To LastRow Step 1
    'если значение в ячейке в строке i столбца 3 = непустая и строка не скрытая, то
    If Cells(r, 3) <> "" And Rows(r).Hidden = False Then
                
        Cells(r, 1) = N
        N = N + 1
        
    End If
    Next r

Sub рабочийвариант()
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1           'проходим от последней строки до первой
        x = WorksheetFunction.Match(Cells(r, 2), Range("мебель"), 0)
        Cells(r, 3) = IIf(IsEmpty(x), "не ок", "скрыть")
        If Cells(r, 3) = "скрыть" Then Cells(r, 3).EntireRow.Hidden = True 'если в строке пусто - скрываем ее
    Next r
End Sub