Question

每个季度，我都会收到一份包含大量国家/地区的Excel文件，以及针对每个国家/地区公司测量不同变量的多个工作表我应该做的是为每个国家创建一个Excel文件。我到现在所做的只是手动删除它，这需要花费很多时间。

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

我希望我已经清楚明白，所以你可以帮助我。

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

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

通过调用它来执行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

保持一个国家的表格，删除其余的国家

2 个答案: