分割片成多個片材基於在列範圍內的值的

Question

我使用Excel來分割片狀以下到基於一些標準的多個片（優先級）

例如，表（優先級：非常高）可能是這樣的：

我使用數字濾波器在Excel中過濾片和複製filtere d結果成一張新表。

如何讓工作流程更簡單，就像在Excel內部構建VBA程序一樣？

Answer 1

這個宏應該可以工作。但是在運行之前，要拆分的工作表必須是ACtive工作表，並且您必須創建名爲「優先級 - 非常高」，「優先級 - 高」，「優先級 - 低」和/或「優先級 - 「優先級 - 非常低」（這取決於你想要的時候怎麼辦分開）：

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