Объединение макросов

[Pilot]

Всем доброго времени суток.
Можно ли объединить два (несколько) небольших макроса использующие один источник, но разные критерии. Пример:

Sub f5()
Dim i As Long, acontrol As Date, icounter As Long
With Sheets("ХРОНОМЕТРАЖ")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5) = "УТП" And .Cells(i, 29) = "вне базы " And .Cells(i, 1) <> acontrol And .Cells(i, 1) >= Sheets("Подведение итогов").Cells(55, 1) _
And .Cells(i, 1) <= Sheets("Подведение итогов").Cells(55, 2) Then
acontrol = .Cells(i, 1)
icounter = icounter + 1
End If
Next
Sheets("Подведение итогов").Cells(8, 14) = icounter
End With
End Sub

Sub f6()
Dim i As Long, acontrol As Date, icounter As Long
Application.ScreenUpdating = False
With Sheets("ХРОНОМЕТРАЖ")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5) = "УТП" And .Cells(i, 29) = "вне базы " And .Cells(i, 1) <> acontrol And .Cells(i, 1) >= Sheets("Подведение итогов").Cells(56, 1) _
And .Cells(i, 1) <= Sheets("Подведение итогов").Cells(56, 2) Then
acontrol = .Cells(i, 1)
icounter = icounter + 1
End If
Next
Sheets("Подведение итогов").Cells(9, 14) = icounter
End With
End Sub

разница выделена. Сам пробовал это сделать, но увы.

[The_Prist]

Sub f5()
Dim i As Long, acontrol As Date, icounter As Long,li as long
With Sheets("ХРОНОМЕТРАЖ")
For li = 0 to 1
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5) = "УТП" And .Cells(i, 29) = "вне базы " And .Cells(i, 1) <> acontrol And .Cells(i, 1) >= Sheets("Подведение итогов").Cells(55+li, 1) _
And .Cells(i, 1) <= Sheets("Подведение итогов").Cells(55+li, 2) Then
acontrol = .Cells(i, 1)
icounter = icounter + 1
End If
Next
Sheets("Подведение итогов").Cells(8+li, 14) = icounter
next li
End With
End Sub

Выделил, что изменил.

[аналитика]

Sub f5()
   Comm 55, 8
End Sub

Sub f6()
   Comm 56, 9
End Sub
'------------------------------------------------------------------------
Sub Comm(arg1, arg2)
Dim i As Long, acontrol As Date, icounter As Long
With Sheets("ХРОНОМЕТРАЖ")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5) = "УТП" And .Cells(i, 29) = "вне базы " And .Cells(i, 1) <> acontrol And .Cells(i, 1) >= Sheets("Подведение итогов").Cells(arg1, 1) _
And .Cells(i, 1) <= Sheets("Подведение итогов").Cells(arg1, 2) Then
acontrol = .Cells(i, 1)
icounter = icounter + 1
End If
Next
Sheets("Подведение итогов").Cells(arg2, 14) = icounter
End With
End Sub

[Pilot]

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

Sub f5()
Dim i As Long, acontrol As Date, icounter As Long,li as long
With Sheets("ХРОНОМЕТРАЖ")
For li = 0 to 1
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 5) = "УТП" And .Cells(i, 29) = "вне базы " And .Cells(i, 1) <> acontrol And .Cells(i, 1) >= Sheets("Подведение итогов").Cells(55+li, 1) _
And .Cells(i, 1) <= Sheets("Подведение итогов").Cells(55+li, 2) Then
acontrol = .Cells(i, 1)
icounter = icounter + 1
End If
Next
Sheets("Подведение итогов").Cells(8+li, 14) = icounter
next li
End With
End Sub

Выделил, что изменил.

Благодарю, но это если два макроса, а если их таких 10 то li = 0 to 10 или нет?

[The_Prist]

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

Благодарю, но это если два макроса, а если их таких 10 то li = 0 to 10 или нет?

Если 10, то 0 to 9, т.к. начинаем с 0. Всего проходов будет 10. Если указать 0 to 10, то проходов будет 11.

[Pilot]

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

Если 10, то 0 to 9, т.к. начинаем с 0. Всего проходов будет 10. Если указать 0 to 10, то проходов будет 11.

Спасибо, буду пробовать, но завтра

[Hugo121]

Только icounter будет вести себя не так, как в макросах по одному. Возможно, его надо обнулять на каждом шаге внешнего цикла.

[Pilot]

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

Если 10, то 0 to 9, т.к. начинаем с 0. Всего проходов будет 10. Если указать 0 to 10, то проходов будет 11.

все-таки решил попробовать сегодня, что-то не выходит, пишет что нет в библиотеке li (can't find project or library)

[The_Prist]

Известная проблема. Вот здесь я описывал способ устранения.

[Pilot]

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

Известная проблема. Вот здесь я описывал способ устранения.

Вах, волшебник, однако. Еще раз спасибо