Question

不知道为什么我不能通过所有工作表循环此代码。我想要的是，一旦在输入框中写入了一个国家，就循环执行宏的每个工作表，删除不包含所选国家的所有行。没有显示错误，它只是在活动工作表中运行宏，然后停止。

Sub Cleaner()
Dim wb As Workbook
Dim sht As Worksheet
Dim savedel As Boolean
Dim cellcounter As Integer
Dim country As String

country = InputBox("Enter Country to Save")
If country = "" Then Exit Sub

cellcounter = 1

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each wb In Application.Workbooks
  If wb.Name <> "PERSONAL.xlsb" Then
    For Each sht In wb.Worksheets

   Do Until cellcounter > Selection.SpecialCells(xlCellTypeLastCell).Row

    'Ignore deletion of any spacer rows
    If IsEmpty(Range("D" & cellcounter)) = True And IsEmpty(Range("E" & cellcounter)) = True Then
        savedel = 1

        'Ignore heading rows
        ElseIf Len(Range("F" & cellcounter)) > 0 And IsNumeric(Left(Range("F" & cellcounter), 1)) = False Then
            savedel = 1

        'Ignore deletion of the country sought
        ElseIf Range("B" & cellcounter).Value = country Then
            savedel = 1

        'Flag non-country for deletion
        ElseIf Range("B" & cellcounter).Value <> country And IsEmpty(Range("B" & cellcounter).Value) = False Then
            savedel = 0
    End If

    'If flagged, delete row
    If savedel = 0 Then
        Rows(cellcounter).Delete
        cellcounter = cellcounter - 1
    End If

      cellcounter = cellcounter + 1

   Loop

Next sht
End If
Next wb

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

我认为你必须移动cellcounter初始化。

在你的循环Selection.SpecialCells(xlCellTypeLastCell).Row中总是引用相同的选择，甚至从一张纸到另一张。您可能还需要使用sht.Cells.SpecialCells(xlCellTypeLastCell).Row。

您还必须用相对于当前工作表/选择Range的内容替换所有sht.Range。

...
If country = "" Then Exit Sub

' Move cellcounter initialization from here...
'cellcounter = 1

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each wb In Application.Workbooks
    If wb.Name <> "PERSONAL.xlsb" Then
        For Each sht In wb.Worksheets

            ' To here:
            cellcounter = 1

            Do Until cellcounter > sht.Cells.SpecialCells(xlCellTypeLastCell).Row

            'Ignore deletion of any spacer rows
            If IsEmpty(sht.Range("D" & cellcounter)) = True _
            And IsEmpty(sht.Range("E" & cellcounter)) = True Then
                savedel = 1

            'Ignore heading rows
            ElseIf Len(sht.Range("F" & cellcounter)) > 0 And _
            IsNumeric(Left(sht.Range("F" & cellcounter), 1)) = False Then
                savedel = 1

            'Ignore deletion of the country sought
            ElseIf sht.Range("B" & cellcounter).Value = country Then
                savedel = 1

            'Flag non-country for deletion
            ElseIf sht.Range("B" & cellcounter).Value <> country _
            And IsEmpty(sht.Range("B" & cellcounter).Value) = False Then
                savedel = 0

            End If
...

在每个工作表中循环宏

1 个答案: