从工作表中保留一个国家并删除其余国家答案

【问题标题】：Keeping one country from a sheet and deleting the rest从工作表中保留一个国家并删除其余国家
【发布时间】：2015-01-26 02:53:15
【问题描述】：

每个季度我都会收到一个 Excel 文件，其中包含许多国家/地区和几张表，其中针对每个国家/地区的公司测量了不同的变量。我应该用它为每个国家创建一个 Excel 文件。我现在做的只是手动删除它，这需要很多时间。

我上传了一个简单的示例文件。第一张表是原始输出结构，通常带有 20-25 张表，测量来自多个公司和国家的不同变量。在示例中，为了简单起见，我只放置了两个国家：英国和法国。第二张是我需要制作的，只保留英国并删除法国。当然，我也必须只用法国做一个文件。

我希望我已经说清楚了，所以你可以帮助我。

Example file

【问题讨论】：

如果您要发布示例文件，通常最好（除非您需要共享代码）将其设为 xlsx 而不是 xlsm。人们对下载启用宏的文件非常紧张，或者至少应该如此。
话虽如此，我确实下载了它，但不清楚它是否与您的描述相符-您说源文件中有 20-25 张纸-您是否将它们复制粘贴到一张纸上例如“原始输出”，还是有更多看起来完全一样的工作表？

标签： excel vba

【解决方案1】：

我已经使用了一个参数来传递给这个 sub 的过滤器。

Sub there_can_be_only_one(sCOUNTRY As String)
    With Sheets("Original_output").Columns(4)
        With .SpecialCells(xlCellTypeConstants, 2).Offset(0, -2)
            With .SpecialCells(xlCellTypeBlanks)
                'Debug.Print .Address(0, 0)
                .FormulaR1C1 = "=R[-1]C"
            End With
        End With
    End With
    With Sheets("Original_output").Columns(2)
        With .Cells(6, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 1)
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:="<>" & sCOUNTRY, Operator:=xlAnd, Criteria2:="<>"
            With .Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End If
                .AutoFilter
            End With
        End With
    End With
    With Sheets("Original_output").Columns(3)
        With .SpecialCells(xlCellTypeBlanks)
            .Offset(0, -1).ClearContents
        End With
    End With
End Sub

我不确定您希望如何处理某些数据岛底部的边框，因为您的示例只是将它们排除在外。如果需要，您应该编写一些代码在行删除后恢复它们。

通过调用 sub 来执行它，

Call there_can_be_only_one("UK")
 ... or,
there_can_be_only_one "UK"

【讨论】：

【解决方案2】：

Reddit 用户的回答：

Sub Cleaner()
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

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

Application.ScreenUpdating = False

End Sub

【讨论】：