运行宏时出错 - Next without For

Question

我正在运行下面的代码并在没有 For 的情况下获取 Next，我错过了一些东西。我想保留首先出现的四个excel表 1. 表 1 2. 合并发票 3. 合并_Excel 4. 合并

其余工作表已导入 Excel，需要合并为工作表名称“已合并”，合并后删除。如果执行时出错，我会尝试包含我不想删除的工作表名称并添加 end。

代码 1：（此代码通过过滤 K 列并将过滤后的项目复制到以发票编号命名的工作表的新工作表中，检查工作表 1 范围内的发票范围在“合并发票”中的发票 p>

Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim Last As Long
Dim sht As String
Dim shtb As String


 sht = "InvoicesConsolidated"
 shtb = "Sheet1"

 'change filter column in the following code
 Last = Sheets(sht).Cells(Rows.Count, "K").End(xlUp).Row
 Set rng = Sheets(sht).Range("A1:K" & Last)

 'Sheets(shtb).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy,   CopyToRange:=Range("AA1"), Unique:=True

  For Each x In shtb.Range([A2], Cells(Rows.Count, "A").End(xlUp))
  With rng
 .AutoFilter
 .AutoFilter Field:=11, Criteria1:=x.Value
 .SpecialCells(xlCellTypeVisible).Copy

 Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
 ActiveSheet.Paste
 End With
 Next x

 'Turn off filter
 Sheets(sht).AutoFilterMode = False

 With Application
 .CutCopyMode = False
 .ScreenUpdating = True
 End With

 Sheets("InvoicesConsolidated").Select

 End Sub

代码 2：（实际上，此代码将匹配发票后创建的工作表合并为一个工作表并删除其余工作表。

Private Sub CommandButton2_Click()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Consolidated").Delete
On Error GoTo 0
Application.DisplayAlerts = False

' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Consolidated"

' Fill in the start row.
StartRow = 1

' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name Then
        If sh.Name <> "Merge_Excel" Then
            If sh.Name <> "Sheet1" Then
                If sh.Name <> "InvoicesConsolidated" Then


        ' Find the last row with data on the summary
        ' and source worksheets.
        Last = LastRow(DestSh)
        shLast = LastRow(sh)

        ' If source worksheet is not empty and if the last
        ' row >= StartRow, copy the range.
        If shLast > 0 And shLast >= StartRow Then
            'Set the range that you want to copy
            Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

           ' Test to see whether there are enough rows in the summary
           ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
               MsgBox "There are not enough rows in the " & _
               "summary worksheet to place the data."
               GoTo ExitTheSub
            End If
            End If
            End If


            StartRow = 1
            ' This statement copies values and formats.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

        End If
        End If
        End If


    Application.DisplayAlerts = False
    If sh.Name <> "Merge_Excel" Then
    If sh.Name <> "Sheet1" Then
    If sh.Name <> "InvoicesConsolidated" Then
        On Error Resume Next
        If sh.Name <> "Consolidated" Then ActiveWorkbook.Worksheets(sh.Name).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
    End If


Next

ExitTheSub:



' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
 'ThisWorkbook.Sheets("Consolidated").Range("A1:K50000").Sort Key1:=ThisWorkbook.Sheets("Consolidated").Range("A2"), Order1:=xlDescending, Header:=xlYes



ReadOutlineCells
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
MsgBox ("Consolidated")
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
On Error GoTo 0
End Function

Function ReadOutlineCells()
Dim rng As Range
Set rng = ActiveWorkbook.Worksheets("Consolidated").Range("A1:K10000")
With rng.Borders
.LineStyle = xlContinuous
.Color = vbBlack
End With
End Function'

Answer 1

您在以下部分中的If <> ... 的多个条件：

If sh.Name <> DestSh.Name Then
        If sh.Name <> "Merge_Excel" Then
            If sh.Name <> "Sheet1" Then
                If sh.Name <> "InvoicesConsolidated" Then

可以很容易地用Select Case 替换，如下面的代码：

Select Case sh.Name

    Case DestSh.Name, "Merge_Excel", "Sheet1", "InvoicesConsolidated"
        ' do nothing

    Case Else
        ' this is the scenario you are describing in your code
        ' rest of your code goes here

End Select                      

Answer 2

如果您更正缩进，您会更快地发现问题。 我在下面进行了尝试，这导致了一些添加的行和一些删除的行。我不确定这是否是您寻求的逻辑，但这里的信息是让您的缩进保持良好状态始终 - 尤其是在编写代码时。

Private Sub CommandButton2_Click()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Consolidated").Delete
    On Error GoTo 0
    Application.DisplayAlerts = False

    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Consolidated"

    ' Fill in the start row.
    StartRow = 1

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
            If sh.Name <> "Merge_Excel" Then
                If sh.Name <> "Sheet1" Then
                    If sh.Name <> "InvoicesConsolidated" Then
                        ' Find the last row with data on the summary
                        ' and source worksheets.
                        Last = LastRow(DestSh)
                        shLast = LastRow(sh)

                        ' If source worksheet is not empty and if the last
                        ' row >= StartRow, copy the range.
                        If shLast > 0 And shLast >= StartRow Then
                            'Set the range that you want to copy
                            Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

                           ' Test to see whether there are enough rows in the summary
                           ' worksheet to copy all the data.
                            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                               MsgBox "There are not enough rows in the " & _
                               "summary worksheet to place the data."
                               GoTo ExitTheSub
                            End If
                        End If
                    End If
                End If


                StartRow = 1
                ' This statement copies values and formats.
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If
        End If


        Application.DisplayAlerts = False
        If sh.Name <> "Merge_Excel" Then
            If sh.Name <> "Sheet1" Then
                If sh.Name <> "InvoicesConsolidated" Then
                    On Error Resume Next
                    If sh.Name <> "Consolidated" Then ActiveWorkbook.Worksheets(sh.Name).Delete
                    On Error GoTo 0
                    Application.DisplayAlerts = True
                End If
            End If
        End If


    Next

ExitTheSub:



    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit
     'ThisWorkbook.Sheets("Consolidated").Range("A1:K50000").Sort Key1:=ThisWorkbook.Sheets("Consolidated").Range("A2"), Order1:=xlDescending, Header:=xlYes



    ReadOutlineCells
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox ("Consolidated")
End Sub