Excel VBA - 是否可以在多个工作表之间增加索引？（一次递增一行，从每张纸中索引一行）

将 rowIndex 初始化为 1 + max（rowIndex） 而不是 1

RowIndex = 1 + WorksheetFunction.Max(Worksheets(1).Range("A:A"), Worksheets(2).Range("A:A"), Worksheets(3).Range("A:A"), Worksheets(4).Range("A:A"))

在开始（循环之前）和循环中使用RowIndex = RowIndex + 1

我确信有一种不那么复杂的方法可以做到这一点，但这是我的尝试，没有考虑到您的手动编辑，该编辑在行号背后没有逻辑。

这将检查行索引的总数是多少，并遍历（有用的）工作表，直到达到行总数。

Sub IncrementIndexesAcrossSheets()
    Dim ws As Worksheet, shIndex As Long, totalShts As Long
    Dim rowIndex As Long, totalRows As Long, lRow As Long
    Dim dict As Object
    
    With ThisWorkbook
        totalShts = .Sheets.Count
        Set dict = CreateObject("Scripting.Dictionary")
        ' Loop through all sheets in the workbook
        For Each ws In .Sheets
            shIndex = shIndex + 1
            ' Skip sheets without data
            If WorksheetFunction.CountA(ws.Cells) > 0 Then
                ' Set the dataRange to the appropriate column (Column B in this case)
                totalRows = totalRows + ws.Cells(Rows.Count, 2).End(xlUp).Row - 1 'taking account for headers
            End If
            dict(shIndex) = shIndex 'adding the sheet indexes to a dictionary to keep track which ones
                                    'are to be used without having to recheck
        Next ws
        shIndex = 1
        Do While rowIndex < totalRows
            If Not dict.Exists(shIndex) Then 'Don't want to accidentally add it with that weird dictionary "bug"
            Else
                With .Sheets(shIndex)
                    lRow = .Range("A" & Rows.Count).End(xlUp).Row
                    If .Range("A" & lRow).Offset(1, 1) <> "" Then
                        rowIndex = rowIndex + 1
                        .Range("A" & lRow).Offset(1).Value = rowIndex
                    Else
                        dict.Remove shIndex 'sheet is all filled out
                    End If
                End With
            End If
            shIndex = shIndex + 1
            If shIndex > totalShts Then shIndex = 1 'don't go over the Sheets.Count
        Loop
    End With
End Sub

如果实际上有任何具体的逻辑可以使它在 sheet4 上为 4-> 7，我将尝试实现它。

编辑：在与 OP 来回一番之后，得到了一些逻辑来实现 sheet4 上的延续，然后再使用分布号返回其原始顺序：

Sub IncrementIndexesAcrossSheets()
    Dim ws As Worksheet, shIndex As Long, totalShts As Long
    Dim rowIndex As Long, totalRows As Long, lRow As Long
    Dim dict As Object
    Dim distriNum
    
    With ThisWorkbook
        totalShts = .Sheets.Count
        Set dict = CreateObject("Scripting.Dictionary")
        ' Loop through all sheets in the workbook
        For Each ws In .Sheets
            shIndex = shIndex + 1
            ' Skip sheets without data
            If WorksheetFunction.CountA(ws.Cells) > 0 Then
                ' Set the dataRange to the appropriate column (Column B in this case)
                totalRows = totalRows + ws.Cells(Rows.Count, 2).End(xlUp).Row - 1 'taking account for headers
            End If
            distriNum = Application.Match("Distribution Number*", ws.Rows(1), 0)
            If IsError(distriNum) Then distriNum = 0 'If it is 0 = no Distribution Number, otherwise column number
            dict(shIndex) = distriNum 'adding the sheet indexes to a dictionary to keep track which ones
                                    'are to be used without having to recheck
        Next ws
        shIndex = 1
        Do While rowIndex < totalRows
            If Not dict.Exists(shIndex) Then 'Don't want to accidentally add it with that weird dictionary "bug"
            Else
                With .Sheets(shIndex)
                    lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    distriNum = dict(shIndex)
                    If .Range("A" & lRow).Offset(0, 1) <> "" Then
                        Do While distriNum > -1
                            rowIndex = rowIndex + 1
                            .Range("A" & lRow).Value = rowIndex
                            If distriNum = 0 Then
                                distriNum = -1
                            ElseIf .Cells(lRow + 1, distriNum).Value = 1 Or .Cells(lRow + 1, distriNum).Value = "" Then
                                distriNum = -1
                            Else
                                lRow = lRow + 1
                            End If
                        Loop
                    Else
                        dict.Remove shIndex 'sheet is all filled out
                    End If
                End With
            End If
            shIndex = shIndex + 1
            If shIndex > totalShts Then shIndex = 1 'don't go over the Sheets.Count
        Loop
    End With
End Sub

现在，这将检查工作表中是否有带有“分发编号”的列，并继续处理该工作表，直到下一个分发编号变回 1 并从那里向前移动。使用预先存在的字典传递分布逻辑的可能列号。