Мой первый макрос

[valerij]

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

По крайней мере, у меня последний вариант (см. пост № 34) работает "влет".

странно, его и пробую
SAS
прикрепите

[SAS888]

Да, увидел. Сегодня уже некогда. Поищите пока сами. Виснет Ваш макрос Private Sub Macro_Change(ByVal Sh As Object). Если его не выполнять - все остальное работает. Попробуйте закомментировать вызывающую его строку.

[valerij]

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

Да, увидел. Сегодня уже некогда. Поищите пока сами. Виснет Ваш макрос Private Sub Macro_Change(ByVal Sh As Object). Если его не выполнять - все остальное работает. Попробуйте закомментировать вызывающую его строку.

понял, попробую, сомневаюсь однако, что смогу.
Смог
Было:
Application.EnableEvents = False
Application.Calculation = xlManual
If Not Intersect(Target, Sh.Range("B3:K1489"))........
А так все работает:
If Not Intersect(Target, Sh.Range("B3:K1489")).......
Application.EnableEvents = False
Application.Calculation = xlManual
For iCount& = 0 To Day(DateSerial(Year(d), Month(d) + 1, 1) - 1) - 1

И еще, так:

Private Sub Workbook_Open()
Run "UnProtectAllSheets"
Run "ProtectAllSheets"
Dim d As Date, dt As Long
d = CDate(Replace(ThisWorkbook.Name, ".xls", " ") & Year(Date))
Sheets(1).Range("A3") = d
dt = Day(DateSerial(Year(d), Month(d) + 1, 1) - 1)
If dt = 30 Then Rows("1443:1489").Select: Selection.EntireRow.Hidden = True
If dt = 31 Then Rows("1443:1489").Select: Selection.EntireRow.Hidden = False
Range("A6").Select
Application.OnKey "{F1}", "Test"
End Sub

Теперь, "имя файла" и в листах, все даты, автоматом.
А вот скрывать, не "нужные" дни(31), на всех листах сразу, без цикла, не знаю, как?
Sheets(Array("ЛЕН", "КИЕВ",................ "Ц-31")).Select, так, что ли?

[valerij]

Во-общем, наворочал, но СУПЕР получилось, имя файла - месяц, все лишнее скрывается(отображается), учитывает февраль, вертикальные ограничения, даты автоматом, может мона проще?

Private Sub Workbook_Open()
Run "UnProtectAllSheets"
Run "ProtectAllSheets"
Dim d As Date, dt As Long, L As Long
d = CDate(Replace(ThisWorkbook.Name, ".xls", " ") & Year(Date))
Sheets(1).Range("A3") = d
dt = Day(DateSerial(Year(d), Month(d) + 1, 1) - 1)
For L = 1 To 13
Sheets(L).Select
Sheets(L).ScrollArea = "A3:K1491"
If dt < 29 Then Rows("1347:1489").Select: Selection.EntireRow.Hidden = True
If dt < 30 Then Rows("1395:1489").Select: Selection.EntireRow.Hidden = True
If dt = 30 Then Rows("1443:1489").Select: Selection.EntireRow.Hidden = True
If dt = 31 Then Rows("1347:1489").Select: Selection.EntireRow.Hidden = False
Sheets(L).Select
ActiveWindow.ScrollRow = 1
Range("A6").Select
Next
Sheets(1).Select
Range("A6").Select
Application.OnKey "{F1}", "Test"
End Sub

[SAS888]

Так будет по-проще:

Private Sub Workbook_Open()

    Dim d As Date, dt As Long, L As Integer
    Run "UnProtectAllSheets": Run "ProtectAllSheets"
    d = CDate(Replace(ThisWorkbook.Name, ".xls", " ") & Year(Date))
    Sheets(1).Range("A3") = d
    dt = Day(DateSerial(Year(d), Month(d) + 1, 1) - 1)
    
    For L = 1 To 13
        With Sheets(L)
            .ScrollArea = "A3:K1491"
            .Rows("1347:1489").Hidden = False
            Select Case dt
                Case Is < 29: .Rows("1347:1489").Hidden = True
                Case Is < 30: .Rows("1395:1489").Hidden = True
                Case Is < 31: .Rows("1443:1489").Hidden = True
            End Select
        End With
    Next
    
    Application.OnKey "{F1}", "Test"
    
End Sub

Совет: по-возможности, не используйте метод Select.
И еще. Наверное, подразумевается, что исходно на всех листах строки с 1347 по 1489 не скрыты? В противном случае, результат будет не всегда правильный. Для того, чтобы от этого ничего не зависело - перед проверкой условий добавлена строка .Rows("1347:1489").Hidden = False

[valerij]

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

Так будет по-проще:
Select
Совет: по-возможности, не используйте метод Select.

А почему? А у Вас?

И еще. Наверное, подразумевается, что исходно на всех листах строки с 1347 по 1489 не скрыты? В противном случае, результат будет не всегда правильный. Для того, чтобы от этого ничего не зависело - перед проверкой условий добавлена строка .Rows("1347:1489").Hidden = False

Не понял "исходно на всех листах "
Ну, когда в месяце 31 день, то да, 1347 по 1489 не скрыты.

Да, проще, класс, за секунды сделал "Июль", раньше час уходил.

Спасибо, Спасибо.
Потихонько начинаю "кумекать".

[SAS888]

1) Метод Select (выбор) во-первых, при выполнении макроса совершенно ни к чему, во-вторых, сильно тормозит. Если по окончании выполнения процедуры необходимо, чтобы выделенной оказалась конкретная ячейка на конкретном листе, тогда Select достаточно выполнить один раз.
2) Если исходно на листе скрыты, например, строки с 1347 по 1489 и dt =31, а в коде отсутствует строка .Rows("1347:1489").Hidden = False , то макрос просто ничего не изменит (т.к. ни одно из проверяемых условий не выполняется).

[valerij]

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

1) Метод Select (выбор) во-первых, при выполнении макроса совершенно ни к чему, во-вторых, сильно тормозит. Если по окончании выполнения процедуры необходимо, чтобы выделенной оказалась конкретная ячейка на конкретном листе, тогда Select достаточно выполнить один раз.
2) Если исходно на листе скрыты, например, строки с 1347 по 1489 и dt =31, а в коде отсутствует строка .Rows("1347:1489").Hidden = False , то макрос просто ничего не изменит (т.к. ни одно из проверяемых условий не выполняется).

2) "Воткнул" два txt макроса(Ваш и свой) в Active File Compare и все увидел, понял
1) Понял

[valerij]

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

При помощи VBA Вашу задачу можно выполнить "кучей" способов. Предлагаю один из них (без цикла).

Sub Multiply()

    Range("F3") = "=(RC[-4]+RC[-2])*RC[-1]"
    Range("F3").AutoFill Destination:=Range("F3:F37")
'      Range("F3:F37").Value = Range("F3:F37").Value
    Range("H3") = "=(RC[-4]+RC[-6])*RC[-1]"
    Range("H3").AutoFill Destination:=Range("H3:H37")
'      Range("H3:H37").Value = Range("H3:H37").Value
    Range("K3") = "=RC[-7]*RC[-1]*0.24"
    Range("K3").AutoFill Destination:=Range("K3:K37")
    Range("F3:K37").Value = Range("F3:K37").Value

End Sub

SAS!
Ваш макрос, я применил, с ним все ясно, а:
Вот, что у меня получилось, без циклов, все дни месяца, все листы, (столбцы "D" и "E", больше, как, где им надо, не пересекаются). Здесь, ввод данных в ст. "D"
Шаг 48, теперь не нужен.

If Not Intersect(Target, Sh.Range("E3:E1477")) Is Nothing Then Macro_Change Sh
If Not Intersect(Target, Range("D3:D1477")) Is Nothing Then
With Range(Target.Address)
.Offset(, 2) = .Offset * .Offset(, 1)     'Это F = D * E
.Offset(, 4) = .Offset * .Offset(, 3)     'Это H = D * G
.Offset(, 7) = .Offset * .Offset(, 6) * 0.24     'Это K = D * J * .24
End With
End If

Ваше мнение относительно способа "Offset"?
Не получается сделать, вот так: 'Это F = (D+В) * E и 'Это H = (D+В) * G
п.3 Диапазон ввода данных(B и D), меняю
Target, Range("B3:B1477,D3:D1477")
Наверное, нет решения?

[SAS888]

Реализовать требуемые Вами формулы, при изменении ячеек любого из диапазонов с помощью метода Offset можно так:

If Not Intersect(Target, Range("D3:D1477")) Is Nothing Then
        With Range(Target.Address)
            .Offset(, 2) = (.Offset + .Offset(, -2)) * .Offset(, 1)  'Это F = (D+B) * E
            .Offset(, 4) = (.Offset + .Offset(, -2)) * .Offset(, 3)     'Это H = (D+B) * G
        End With
    End If
    
    If Not Intersect(Target, Range("B3:B1477")) Is Nothing Then
        With Range(Target.Address)
            .Offset(, 4) = (.Offset + .Offset(, 2)) * .Offset(, 3)  'Это F = (D+B) * E
            .Offset(, 6) = (.Offset + .Offset(, 2)) * .Offset(, 5)     'Это H = (D+B) * G
        End With
    End If

Решение таким способом работоспособно, но мне кажется, что предложенный мною способ (макросом вставить формулу в ячейку, "растянуть" ее на весь диапазон, затем, если нужно, удалить формулу) лучше, т.к. позволяет изменять в контролируемом диапазоне несколько данных одновременно (копировать - вставить, или очистить).