VBA，向上/向下填充行以与最后一行对齐

Question

我正在尝试删除行直到它遇到我的最后一行或填写行以与最后一行对齐。

有时我的工作表如下所示，我需要删除行以与我的最后一个行号对齐。：

但有时我的工作表如下所示，我需要填写其他列：

有没有可以做到这一点的功能？我发现很难确定何时填满或填满。

谢谢

Answer 1

记住使用 UsedRange 的众所周知的注意事项，您可以尝试一下

Dim lastRow As Long
With ActiveSheet ' <- change it to your actual sheet reference
    With .UsedRange
        lastRow = .Rows(.Rows.Count)
    End With
End With

Answer 2

请测试下一个代码。它假定参考列将是第七个，而要检查 0 公式值的列是第六个。您的图片不包含列标题...

Sub DeleteRowsOrFillDownDiscontinuous()
 Dim sh As Worksheet, lastR As Long, lastR1 As Long, lastCol As Long

 Set sh = ActiveSheet
 lastR = sh.Range("F" & rows.count).End(xlUp).row
 lastR1 = Range("E" & rows.count).End(xlUp).row
 lastCol = sh.cells(lastR1, Columns.count).End(xlToLeft).Column

 If lastR < lastR1 Then
    sh.rows(lastR + 1 & ":" & lastR1).EntireRow.Delete xlUp
 ElseIf lastR > lastR1 Then
    sh.Range("A" & lastR1, "E" & lastR1).AutoFill _
        Destination:=sh.Range("A" & lastR1, sh.Range("E" & lastR))
    sh.Range("G" & lastR1, "AG" & lastR1).AutoFill _
       Destination:=sh.Range("G" & lastR1, "AG" & lastR)
    sh.Range("AI" & lastR1, sh.cells(lastR1, lastCol)).AutoFill _
       Destination:=sh.Range("AI" & lastR1, sh.cells(lastR, lastCol))
 Else
    MsgBox "Nothing te be processed. Everything aligned..."
 End If
End Sub

已编辑：

修改了F:F列的代码作为参考，AH:AH也不能改变，现有列要在AH列之后处理。

请对其进行测试并发送一些反馈。