从一张纸上保留一个国家，删除其余国家

每个季度我都会收到一个有很多国家的Excel文件，并且每个国家的公司都会测量不同的variables。 我应该做的是为每个国家创build一个Excel文件。 到目前为止我所做的只是手动删除它，这需要花费很多时间。

我上传了一个简单的示例文件。 第一张纸是原始的输出结构，通常来自20-25张，测量来自几个公司和国家的不同variables。 在这个例子中，为了简单起见，我只是把两个国家：英国和法国。 第二张纸是我需要生产，只保留英国和删除法国。 当然，我也只有一个法国文件。

我希望我已经明确了，所以你可以帮助我。

示例文件

Answer 1

我已经使用了一个parameter passing给这个子filter。

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