根据列中的值范围将工作表拆分为多个工作表

Question

我正在使用Excel根据某些条件（优先级）将像下面这样的工作表拆分成多个工作表

例如，工作表（优先级：非常高）可能如下所示：

我在Excel中使用数字过滤器来过滤工作表并将过滤后的结果复制到新工作表中。

如何使工作流程更简单，例如在Excel中构建VBA程序？

Answer 1

这个宏应该可行。但在运行之前，您要分割的工作表必须是ACtive Sheet，您必须创建名为＆＃34;优先级 - 非常高＆＃34;，＆＃34;优先级 - 高＆＃34的新空白工作表;，＆＃34;优先级 - 低＆＃34;和/或＆＃34;优先级 - 非常低＆＃34; （取决于你当时想做什么分裂）：

Sub Splitsheets()
Dim Priority As String

Priority = InputBox("Enter the priority (Very High, High, Low or Very Low)")

If Priority = "Very High" Then
    With ActiveSheet.Range("A:D")
         .AutoFilter Field:=3, Criteria1:=">=5"
         .AutoFilter Field:=4, Criteria1:="<5"
    End With
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Worksheets("Priority - Very High").Range("A1")

ElseIf Priority = "High" Then
    With ActiveSheet.Range("A:D")
         .AutoFilter Field:=3, Criteria1:="<5"
         .AutoFilter Field:=4, Criteria1:="<5"
    End With
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Worksheets("Priority - High").Range("A1")

ElseIf Priority = "Low" Then
    With ActiveSheet.Range("A:D")
         .AutoFilter Field:=3, Criteria1:=">=5"
         .AutoFilter Field:=4, Criteria1:=">=5"
    End With
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Worksheets("Priority - Low").Range("A1")

ElseIf Priority = "Very Low" Then
    With ActiveSheet.Range("A:D")
         .AutoFilter Field:=3, Criteria1:="<5"
         .AutoFilter Field:=4, Criteria1:=">=5"
    End With
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Worksheets("Priority - Very Low").Range("A1")
End If

ActiveSheet.ShowAllData

End Sub

Answer 2

我实际上找到了解决这个问题的方法： 效率不高，但很容易理解。

Sub VeryHigh()
Dim LastRow As Long

ActiveWorkbook.Sheets.Add.Name = "Very High Priority"


Sheets("Very High Priority").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$D").AutoFilter field:=3, Criteria1:=">=5"
    .Range("$A:$D").AutoFilter field:=4, Criteria1:="<5"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Very High Priority").Range("A1")

End With
    Worksheets("Sheet1").Activate
    ActiveSheet.ShowAllData

End Sub

Sub High()
Dim LastRow As Long

ActiveWorkbook.Sheets.Add.Name = "High Priority"


Sheets("High Priority").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$D").AutoFilter field:=3, Criteria1:="<5"
    .Range("$A:$D").AutoFilter field:=4, Criteria1:="<5"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("High Priority").Range("A1")

End With
    Worksheets("Sheet1").Activate
    ActiveSheet.ShowAllData

End Sub

Sub Low()
Dim LastRow As Long

ActiveWorkbook.Sheets.Add.Name = "Low Priority"


Sheets("Low Priority").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$D").AutoFilter field:=3, Criteria1:=">=5"
    .Range("$A:$D").AutoFilter field:=4, Criteria1:=">=5"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Low Priority").Range("A1")

End With
    Worksheets("Sheet1").Activate
    ActiveSheet.ShowAllData

End Sub
Sub VeryLow()
Dim LastRow As Long

ActiveWorkbook.Sheets.Add.Name = "Very Low Priority"


Sheets("Very Low Priority").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$D").AutoFilter field:=3, Criteria1:="<5"
    .Range("$A:$D").AutoFilter field:=4, Criteria1:=">=5"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Very Low Priority").Range("A1")

End With
    Worksheets("Sheet1").Activate
    ActiveSheet.ShowAllData

End Sub