сократить код

[Kirja23]

Всем привет,

опять нужна ваша помощь, надо сократить следующий код, код рабочий, только в таком состоянии очень длинный:

Sub x1()

    Dim rowDate As Long
    Dim rowTotal As Long
    Dim sum As Double
    Dim emptyCellCount As Long
        
    rowDate = 2
    sum = 0
    
    Do Until (Sheets("лист1").Cells(rowDate, 1).Value = "")
    
        If (Sheets("лист1").Cells(rowDate, 5).Value <> "") Then
            
             rowTotal = 3
             emptyCellCount = 0
             Do Until (emptyCellCount = 10) 'stop after 10 empty cell => end of sheet
             
                If (Sheets("лист1").Cells(rowDate, 2).Value <> "" _
                And Sheets("общий").Cells(rowTotal, 4).Value = Sheets("лист1").Cells(rowDate, 2).Value _
                And Sheets("общий").Cells(rowTotal, 11).Value <> "") Then
                
                   sum = sum + (Sheets("лист1").Cells(rowDate, 5).Value / Sheets("общий").Cells(rowTotal, 11).Value) / 60
                   
                   Exit Do 'Performance
                
                End If
                
                rowTotal = rowTotal + 1
                
                If (Sheets("общий").Cells(rowTotal, 4).Value = "") Then
                    emptyCellCount = emptyCellCount + 1
                Else
                    emptyCellCount = 0
                End If
             
             Loop
            
        End If
            
        rowDate = rowDate + 1
        
    Loop
    
    Sheets("результат").Cells(30, 3) = sum
    
End Sub

Sub x2()

    Dim rowDate As Long
    Dim rowTotal As Long
    Dim sum As Double
    Dim emptyCellCount As Long
        
    rowDate = 2
    sum = 0
    
    Do Until (Sheets("лист2").Cells(rowDate, 1).Value = "")
    
        If (Sheets("лист2").Cells(rowDate, 5).Value <> "") Then
            
             rowTotal = 3
             emptyCellCount = 0
             Do Until (emptyCellCount = 10) 'stop after 10 empty cell => end of sheet
             
                If (Sheets("лист2").Cells(rowDate, 2).Value <> "" _
                And Sheets("общий").Cells(rowTotal, 4).Value = Sheets("лист2").Cells(rowDate, 2).Value _
                And Sheets("общий").Cells(rowTotal, 11).Value <> "") Then
                
                   sum = sum + (Sheets("лист2").Cells(rowDate, 5).Value / Sheets("общий").Cells(rowTotal, 11).Value) / 60
                   
                   Exit Do 'Performance
                
                End If
                
                rowTotal = rowTotal + 1
                
                If (Sheets("общий").Cells(rowTotal, 4).Value = "") Then
                    emptyCellCount = emptyCellCount + 1
                Else
                    emptyCellCount = 0
                End If
             
             Loop
            
        End If
            
        rowDate = rowDate + 1
        
    Loop
    
    Sheets("результат").Cells(31, 3) = sum
    
End Sub

Sub x3()

    Dim rowDate As Long
    Dim rowTotal As Long
    Dim sum As Double
    Dim emptyCellCount As Long
        
    rowDate = 2
    sum = 0
    
    Do Until (Sheets("лист3").Cells(rowDate, 1).Value = "")
    
        If (Sheets("лист3").Cells(rowDate, 5).Value <> "") Then
            
             rowTotal = 3
             emptyCellCount = 0
             Do Until (emptyCellCount = 10) 'stop after 10 empty cell => end of sheet
             
                If (Sheets("лист3").Cells(rowDate, 2).Value <> "" _
                And Sheets("общий").Cells(rowTotal, 4).Value = Sheets("лист3").Cells(rowDate, 2).Value _
                And Sheets("общий").Cells(rowTotal, 11).Value <> "") Then
                
                   sum = sum + (Sheets("лист3").Cells(rowDate, 5).Value / Sheets("общий").Cells(rowTotal, 11).Value) / 60
                   
                   Exit Do 'Performance
                
                End If
                
                rowTotal = rowTotal + 1
                
                If (Sheets("общий").Cells(rowTotal, 4).Value = "") Then
                    emptyCellCount = emptyCellCount + 1
                Else
                    emptyCellCount = 0
                End If
             
             Loop
            
        End If
            
        rowDate = rowDate + 1
        
    Loop
    
    Sheets("результат").Cells(32, 3) = sum
    
End Sub

заранее очень благодарен!

[Skif-F]

Создайте процедуру:
Sub xx(ИмяЛиста as String, НомерСтроки as Long)
Вставьте в неё содержимое любой из Ваших процедур, заменив строки "лист1"..."лист3" на ИмяЛиста, и
Sheets("результат").Cells(32, 3) = sum
на
Sheets("результат").Cells(НомерСтро ки , 3) = sum

А на будущее: не забывайте вставлять файл с примером.

P.S. Вышеуказанные процедуры сократятся до:
Sub x1()
xx "лист1", 30
End Sub