Можно упростить этот макрос?

[valerij]

Сообщение от EducatedFool

А что ЭТО такое?
Часть формулы, или кусок макроса?

Формула, слаживает с 30 книг с Листов №2- имя листа, ячейки Н5

[SAS888]

Предыдущее Ваше упрощение я бы сделал так:

Sub Main()
    Dim листы As Integer, i As Integer, j As Integer, ttL As Long
    ttL = 0: j = 15
    a = Array(33, 34, 61, 62, 63, 89, 90, 117, 118, 145, 146, 147, 173, 174, 201, 202, 229, 230, 231, 257, 258, 285, 286, 313, 314, 315, 341, 342, 369, 370)
    For листы = 5 To 9
        With Sheets(листы)
            For i = LBound(a) To UBound(a)
                .Cells(j, "H") = Sheets(1).Cells(a(i), "E").Offset(ttL): j = j + 21
            Next
        End With
    Next
End Sub

[valerij]

А тут, упростить??? (по другому не смог)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim x As Byte, y As Byte, z As Byte, с As Byte
Application.EnableEvents = False
    With [C5:H16].Application
        For x = 5 To 16
            Cells(x, 8) = .Sum(Range(Cells(x, 3), Cells(x, 7)))
        Next
    End With
    
    With [C26:E35].Application
        For y = 26 To 35
            Cells(y, 6) = .Sum(Range(Cells(y, 3), Cells(y, 5)))
        Next
    End With
    
    With [f41:h47].Application
        For z = 41 To 47
            Cells(z, 9) = .Sum(Range(Cells(z, 6), Cells(z, 8)))
        Next
    End With
    
    With [c54:h65].Application
        For c = 54 To 65
            Cells(c, 9) = .Sum(Range(Cells(c, 3), Cells(c, 8)))
        Next
    End With
    
Application.EnableEvents = True
End Sub

Вот интересно, почему, вставляю - дергается экран???
Application.ScreenUpdating = False

[EducatedFool]

Валера, а зачем вот эти строки?

With [C5:H16].Application
    With [C26:E35].Application

Может, в них скрыт какой-то тайный смысл?

PS: Ты первый, кто додумался до такой конструкции...

[valerij]

Сообщение от EducatedFool

Валера, а зачем вот эти строки?.

Игорь, я думал, что так я защищаю др. яч. от случайного ввода, т. к. только в этих диапазонах вводятся с клавы числа, а че НЕТ?

Про защиту яч. я знаю, но лист защитить не могу, нужен
Да, убрал и все ОК, ну ваще, класс я придумал, пацтулом!!

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim x As Byte, y As Byte, z As Byte, с As Byte
Application.EnableEvents = False
    With Application
        For x = 5 To 16
            Cells(x, 8) = .Sum(Range(Cells(x, 3), Cells(x, 7)))
        Next
        For y = 26 To 35
            Cells(y, 6) = .Sum(Range(Cells(y, 3), Cells(y, 5)))
        Next
        For z = 41 To 47
            Cells(z, 9) = .Sum(Range(Cells(z, 6), Cells(z, 8)))
        Next
        For c = 54 To 65
            Cells(c, 9) = .Sum(Range(Cells(c, 3), Cells(c, 8)))
        Next
    End With
    
Application.EnableEvents = True
End Sub

[The_Prist]

Можно еще чуть упростить

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim x As Byte
    With Application
        .EnableEvents = False
        For x = 5 To 65
            Select Case x
            Case 5 To 16: Cells(x, 8) = .Sum(Range(Cells(x, 3), Cells(x, 7)))
            Case 26 To 35: Cells(x, 6) = .Sum(Range(Cells(x, 3), Cells(x, 5)))
            Case 41 To 47: Cells(x, 9) = .Sum(Range(Cells(x, 6), Cells(x, 8)))
            Case 54 To 65: Cells(x, 9) = .Sum(Range(Cells(x, 3), Cells(x, 8)))
            End Select
        Next
        .EnableEvents = True
    End With
End Sub

[valerij]

Сообщение от The_Prist

Можно еще чуть упростить]

Ага, !!!!, тока, может я чета путаю, но де то я читал, типа: избегайте применять Select Case, правда почему, не объяснили

[The_Prist]

Избегать Select Case надо только в том случае, если Вам значение после первой проверки, необходимо проверить дальше. Select Case такой возможности не дает - при первом совпадении условия данный оператор заканчивает свою обработку и переходит на End Select. В Вашем случае Select Case вполне подходит.

[valerij]

Сообщение от The_Prist

В Вашем случае Select Case вполне подходит.

Спасибо!!!!!
---------------
| ^^пиво^^ \\|""\\_,_
|___________||___|__|)
(@)(@)""*|(@)(@)**(@)

[valerij]

Добрый Вечер
Давненько не тревожил, но, получаю ошибку, не могу разобраться, надеюсь на Вашу поддержку.
Ошибка возникает красным, почему не мугу сложить?

Sub zxc()
    Dim Левый#(1 To 2, 1 To 1), iPrices#(1 To 2, 1 To 1), iRow&, iLL As Byte
    Application.EnableEvents = False
            For iLL = 1 To 1
    iPrices(1, 1) = 3.32
    iPrices(2, 1) = 2.73
    
    Левый(1, 1) = 0.65 * 0.3
    Левый(2, 1) = 0.45 * 0.3
        For iRow = 3 To 1323 Step 44
                With Sheets(iLL)
                    .Cells(iRow, 5).Resize(31).Value = iPrices
                    .Cells(iRow, 14).Resize(31).Value = iPrices + Левый
                End With
             Next
                Erase iPrices
        Next
            Application.EnableEvents = True
End Sub