Question

我正在尝试运行此宏，以便在删除行后将数据移到多个工作表上。我一直收到编译错误

如果没有阻止，则结束

这是我的VBA代码：

Sub shiftmeup()
    Dim ws As Worksheet
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts
    Set ws1 = wb.Sheets("Deposits")
    Set ws2 = wb.Sheets("Lending")
    Set ws3 = wb.Sheets("Client Notes")

    With ws.Range("D11:BJ392")
        For i = .Rows.Count To 1 Step -1
            If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
        Next

    With ws1.Range("E11:l392")
        For i = .Rows.Count To 1 Step -1
            If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
        Next


    With ws2.Range("E11:Y392")
        For i = .Rows.Count To 1 Step -1
            If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
        Next

    With ws3.Range("E11:E392")
        For i = .Rows.Count To 1 Step -1
            If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp

            End If
        Next
    End With
End Sub

Answer 1

始终正确格式化和缩进代码，否则您无法查看问题（我在您的问题中为您做了这些）。

现在您看到前3个With没有End With。每个With都需要自己的End With！

还有一个End If过多，因为您的所有If语句都是1行，然后不需要End If。

If语句有两种类型：

1-liners If … Then … Else
```
If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
```
请注意，在1行语句中，不允许End If。

多个衬垫

If IsEmpty(.Cells(i, 1)) Then 
    .Rows(i).Delete Shift:=xlUp
End If

你不能混合它们。

此外，我建议使用描述性变量名称而不是ws1，ws2，...这使您的代码更易读，更易于维护。

Answer 2

@Peh已经告诉过你你的问题

以下是您的代码可能的重构

首先，将重复性任务分配给特定的例程：

Sub DeleteSheetRows(rng As Range)
    If WorksheetFunction.CountBlank(rng) > 0 Then rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

然后从“主要”代码中调用该特定例程：

Sub shiftmeup()
    Dim ws As Worksheet
    Dim sheetNames As Variant, rangeAddresses As Variant
    Dim i As Long

    sheetNames = Array("contactunder", "Deposits", "Lending", "Client Notes")
    rangeAddresses = Array("D11:BJ392", "E11:l392", "E11:Y392", "E11:E392")

    With ThisWorkbook ' reference desired workbook
        For i = 1 To UBound(sheetNames) ' loop through sheet names
            DeleteSheetRows .Worksheets(sheetNames(i)).Range(rangeAddresses(i)) ' call rows deleting routin passing current worksheet proper range
        Next
    End With
End Sub

结束IF无块编译错误

2 个答案: