помогите оптимизировать код.

[kievlyanin]

вот собственно код:

Dim j As Long

For Z = 1 To 65536
If Sheets("для внесения").Cells(Z, "E").Value = 0 And _
Sheets("для внесения").Cells(Z, "U").Value = 0 And _
Sheets("для внесения").Cells(Z, "W").Value = 0 Then Exit For
Next

a = Sheets("для внесения").Range(Sheets("для внесения").Cells(2, 21), Sheets("для внесения").Cells(Z, 21)).Value 
b = Sheets("для внесения").Range(Sheets("для внесения").Cells(2, 23), Sheets("для внесения").Cells(Z, 23)).Value 
c = Sheets("для внесения").Range(Sheets("для внесения").Cells(2, 25), Sheets("для внесения").Cells(Z, 25)).Value 

For Each cell In Range(Cells(Range("Tab_1").Row, "B"), Cells(Range("System").Row, "IE"))

If cell.Interior.ColorIndex = 6 And Cells(Range("Tab_1").Row, cell.Column) = "этикиро-вано" Then
cell.ClearContents
 
  For j = 1 To UBound(a, 1)
If Cells(cell.Row, "C") = a(j, 1) And _
Cells(Range("System").Row + 2, cell.Column) = b(j, 1) And _
Cells(Range("System").Row + 1, cell.Column) = c(j, 1) Then

Sheets("для внесения").Cells(j + 1, "E").Copy
cell.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
        :=False, Transpose:=False
End If
Next j


End If

Next cell

значит дело в следующем - формулы пробовал не подходит! таблица большая файл тупо виснет + эта таблица обязательно должна работать в третьем экселе.... решил сделать через вба .. по сути тут заменяется формула седьмого СУММЕСЛИМН - три условия при которых идет суммирование.

код рабочий - но долгорабочий .. как ускорить?? или может подскажите альтернативный вариант??

[EducatedFool]

Попробуйте такой вариант:

Sub testNEW()
    Application.ScreenUpdating = False
    With Sheets("для внесения")
        z = .Cells.SpecialCells(xlCellTypeLastCell).Row
        a = .Range(.Cells(2, 21), .Cells(z, 21)).Value
        b = .Range(.Cells(2, 23), .Cells(z, 23)).Value
        c = .Range(.Cells(2, 25), .Cells(z, 25)).Value

        For Each cell In Range(Cells(Range("Tab_1").Row, "B"), Cells(Range("System").Row, "IE"))
            If cell.Interior.ColorIndex = 6 And Cells(Range("Tab_1").Row, cell.Column) = "этикиро-вано" Then
                cell.ClearContents
                For j = 1 To UBound(a, 1)
                    If Cells(cell.Row, "C") = a(j, 1) And _
                       Cells(Range("System").Row + 2, cell.Column) = b(j, 1) And _
                       Cells(Range("System").Row + 1, cell.Column) = c(j, 1) Then

                        .Cells(j + 1, "E").Copy
                        cell.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False
                    End If
                Next j
            End If
        Next cell
    End With
End Sub

Безусловно, можно ещё значительно сократить и оптимизировать код, но без примера файла это сделать сложно.

[kievlyanin]

2 EducatedFool

файл .. блин ща попробую ... по коду спасибо, но разве это ускорит его выполнение??

[kievlyanin]

вот файл - урезанный, но сути дела не меняет - на листе "для внесения" забиваются данные - в листе "форма С1.1" они упорядочиваются по трем критериям - имя товара, завод, месяц

значит повторюсь - нужен аналог суммеслимн но через вба чтобы без формул т.к. реальный файл не выдержит такого количества вычислений + обязательно файл должен работать в третьем экселе.