如何在 Excel 2016 中使用 VBA 用与上面单元格中相同的值填充空白单元格？

Question

我创建了一个表单，从 2 个不同的工作表收集数据，并且在输出表中，如果有空白单元格，则需要用上面写的值填充

Sub FillBlanksProtocol()
    Dim wsProtocol As Worksheet
    Dim LastRow As Long
    Dim col As Integer
    Dim row As Long
    On Error Resume Next

    ' Set the Protocol sheet
    Set wsProtocol = ThisWorkbook.Sheets("Protocol")

    ' Determine the last row in column A
    LastRow = wsProtocol.Cells(wsProtocol.Rows.Count, 1).End(xlUp).row

    ' Loop through columns A:H (1 to 8)
    For col = 1 To 8
        For row = 2 To LastRow ' Start from row 2 to avoid referencing non-existent rows
            With wsProtocol
                ' Check if the current cell is empty
                If IsEmpty(.Cells(row, col).Value) Then
                    ' Stop copying if there is data to the left
                    If col > 1 And Not IsEmpty(.Cells(row, col - 1).Value) Then Exit For

                    ' Fill the current cell
                    If col = 1 Then
                        ' For column A: Increment the value from the cell above
                        If Not IsEmpty(.Cells(row - 1, col).Value) Then
                            .Cells(row, col).Value = .Cells(row - 1, col).Value + 1
                        End If
                    Else
                        ' For other columns: Copy the value from the cell above
                        If Not IsEmpty(.Cells(row - 1, col).Value) Then
                            .Cells(row, col).Value = .Cells(row - 1, col).Value
                        End If
                    End If
                End If
            End With
        Next row
    Next col

    On Error GoTo 0
End Sub

我尝试循环遍历

Answer 1

Option Explicit

Sub FillBlanksProtocol()
    Dim wsProtocol As Worksheet
    Dim LastRow As Long, c As Long, r As Long

    ' Set the Protocol sheet
    Set wsProtocol = ThisWorkbook.Sheets("Protocol")
    With wsProtocol
        ' Determine the last row in column A
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).row

        ' Start from row 2 to avoid referencing non-existent rows
        For r = 2 To LastRow
            ' Loop through columns A:H (1 to 8)
            For c = 1 To 8
                ' Check if the current cell is empty
                If IsEmpty(.Cells(r, c)) Then
                    If c = 1 Then
                        ' For column A: Increment the value from the cell above
                        .Cells(r, c) = .Cells(r - 1, c) + 1
                    Else
                        ' For other columns: Copy the value from the cell above
                        .Cells(r, c) = .Cells(r - 1, c)
                    End If
                End If
            Next c
        Next r
    End With
    
End Sub