从 sheet 中保留一个国家并删除其余国家

Question

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

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

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

Example file

Answer 1

我已经使用一个参数传递给这个潜艇的过滤器。

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

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

通过调用它来执行子程序，

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

Answer 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

从 sheet 中保留一个国家并删除其余国家

Keeping one country from a sheet and deleting the rest

excel

vba