Sub d()
Dim arr, arr2, i As Long, j As Long, lr As Long
Dim col2 As New Collection
lr = Cells(Rows.Count, 2).End(xlUp).Row
lr2 = Cells(Rows.Count, 5).End(xlUp).Row
arr = Range(Cells(6, 2), Cells(lr, 3)): arr2 = Range(Cells(6, 5), Cells(lr2, 6))

For i = LBound(arr2) To UBound(arr2)
    On Error Resume Next
    col2.Add arr2(i, 1) & "///" & arr2(i, 2), CStr(arr2(i, 1) & "///" & arr2(i, 2))
Next i

For i = LBound(arr) To UBound(arr)
    On Error Resume Next
    col2.Add arr(i, 1) & "///" & arr(i, 2), CStr(arr(i, 1) & "///" & arr(i, 2))
Next i

arr2 = Range(Cells(6, 5), Cells(lr2, 6)).ClearContents
ReDim arr2(1 To col2.Count, 1 To 2)
For i = 1 To col2.Count
    arr2(i, 1) = Split(col2(i), "///")(0)
    arr2(i, 2) = Split(col2(i), "///")(1)
Next i

Range("E6").Resize(UBound(arr2), 2) = arr2
End Sub

 =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(104;$C$1:C1)+1

Sub asd()
Dim i As Long, cell As Range, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range(Cells(2, 1), Cells(lr, 1)).SpecialCells(xlCellTypeVisible)
Rng.Offset(0, 2).ClearContents
For Each cell In Rng
    cell.Offset(0, 2) = _
    Application.WorksheetFunction.Max( _
    Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible)) + 1
Next cell
End Sub

Sub ddd()
Dim rng As Range, cell As Range, i As Long
Set rng = Application.InputBox("Выдели ячейки из которых нужно получить текст, результат будет выведен справа от каждой ячеке", Type:=8)
For Each cell In rng
txt = ""
    If IsNumeric(cell) Then
        For i = 1 To cell
            If txt = "" Then
                txt = "image_" & i & ".jpg"
            Else
                txt = txt & ",image_" & i & ".jpg"
            End If
        Next i
    End If
    cell.Offset(0, 1) = txt
Next cell
End Sub

Sub Макрос4()
Dim sh As Worksheet, sh2 As Worksheet, i As Long, j As Long, lr As Long, lr2 As Long
Set sh = ActiveSheet
Set sh2 = Worksheets("База")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    t1 = sh.Cells(i, 1): t2 = sh.Cells(i, 2)
    For j = 2 To lr2
        t3 = sh2.Cells(j, 1): t4 = sh2.Cells(j, 2)
        If t1 = t3 And t2 = t4 Then
        sh2.Cells(j, 3).Resize(1, 10).Copy
        sh.Cells(i, 3).PasteSpecial Paste:=xlPasteValues
        Exit For
        End If
    Next j
Next i
End Sub

Sub false_filter()
    Cells.EntireRow.Hidden = False
End Sub

Sub filter_for_list()
Dim list As Range, i As Long, cell As Range, rng_filter As Range, k As Long, col_name As Long
col_name = Application.InputBox("Укажи номер столбца по которому фильтровать", Type:=1)
Set list = Application.InputBox("Выбери данные по которым хочешь сделать фильтр", Type:=8)
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, col_name).End(xlUp).Row
    For Each cell In list
        If cell = Cells(i, col_name) Then
            k = k + 1
            Exit For
        End If
    Next cell
        If k = 0 Then
            If rng_filter Is Nothing Then
                Set rng_filter = Cells(i, col_name)
            Else
                Set rng_filter = Union(rng_filter, Cells(i, col_name))
            End If
        End If
k = 0
Next i
If Not rng_filter Is Nothing Then rng_filter.EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub

A(i) = Val(Cells(4, i ).Value)

A(i) = Val(Cells(4, i + 1).Value)