分割片成多个片材基于在列范围内的值的

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