将多个 ForEach 和 With 循环清理为单个操作

Question

我没有得到符合我需要的搜索结果，我认为这与我的用词或术语有关。我基本上是在寻找正确的词来搜索或链接到地方以找到下一步要去的方向。（而不是只是转储代码的人，我在这里学习......）。

我希望将多个“For Each”和“With”循环组合成一个动作，以节省 overhead/time 的处理时间。

目前我从主要的“数据转储 sheet”中提取数据，并将我需要的原始列复制到“列清理”sheet。从“ColScrub”sheet，然后使用（至少）三个单独的“For Each”循环将数据过滤到我需要的数据，到目前为止效果很好，尽管有时有 20 + pull/scrub 数据和我现在拥有的东西的第二次延迟限制了未来的扩展。

最基本的运行下来是我正在从“ColScrub”sheet 读取数据，我让它创建了一个新的温度 sheet，并将一些过滤后的数据粘贴到温度 1 .

之后，我再次读取 Temp1 和“For Each”，将额外过滤的数据粘贴到新的 Temp2 sheet。

最后，我从 Temp2 读取并使用另一个“For Each”循环进一步过滤数据，然后将数据粘贴到 Temp3。

Temp3 本质上具有我需要的“干净数据”，并从那里运行其他 vba 或来自该清洁数据的公式来提供可呈现的数据。

从“数据转储 sheet”到填充的温度的代码片段Sheet3:

Sub CopyRowDataToDiffSheets()
Dim LastRowFromColScrubE As Integer
Dim LastRowFromTemp1 As Integer
Dim LastRowFromTemp2 As Integer
Dim LastRowFromTemp3 As Integer
Dim x As Integer
Dim c1 As Range
Dim sName1 As String
Dim sName2 As String
Dim sName3 As String
sName1 = "Temp1"
sName2 = "Temp2"
sName3 = "Temp3"
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'''''''''''''''''Copy filter data to TempSheet1
Worksheets.Add().Name = sName1  'make Sheet Temp1
LastRowFromColScrubE = Sheets("ColScrub").Range("E" &     Rows.Count).End(xlUp).Row: x = 1 'count items in col E
For Each c1 In Sheets("ColScrub").Range("E1:E" & LastRowFromColScrubE)  'However many rows are in ColE on ColScrub sheet, set C1 counter as its index
If c1.Value = "In-Progress" Or c1.Value = "Jeopardy" Then  'Add value to index if InProg/Jeo are found in colE
c1.EntireRow.Copy Worksheets("Temp1").Range("A" & x)  'paste date from ColScrub to Sheet Temp1
        x = x + 1
    End If
Next c1


'''''''''''''''''Copy filter data to TempSheet2
Worksheets.Add().Name = sName2
LastRowFromTemp1 = Sheets("Temp1").Range("D" & Rows.Count).End(xlUp).Row: x = 1
For Each c1 In Sheets("Temp1").Range("D1:D" & LastRowFromTemp1)
    If c1.Value = "New Connect" Then
        c1.EntireRow.Copy Worksheets("Temp2").Range("A" & x)
        x = x + 1
    End If
Next c1


'''''''''''''''''Copy filter data to TempSheet3
Worksheets.Add().Name = sName3
LastRowFromTemp2 = Sheets("Temp2").Range("F" & Rows.Count).End(xlUp).Row: x = 1
For Each c1 In Sheets("Temp2").Range("F1:F" & LastRowFromTemp2)
    If c1.Value = "New Connect" Or c1.Value = "Change" Then
        c1.EntireRow.Copy Worksheets("Temp3").Range("A" & x)
        x = x + 1
    End If
Next c1

  '[et el]

理想情况下，我只想复制一些特定的列（我已经可以在 ColScrub Sheet 上执行此操作）并从该列数据中复制，然后在 ColE 上过滤仅 'In Progress' 中的项目或'Jeopardy' 状态，以及仅来自 'New Connect' 状态的项目的 ColD 以及 'NewConnect' 或 'Change' 状态的项目的 ColF。

有没有一种方法可以让 ColE/ColD/ColF 过滤器在一个步骤中全部完成（并且可能添加要过滤的内容，例如日期范围的 ColAA 和文本的 ColAB 等）

如果说得通。

然后我发现了一些关于过滤的东西，如下所示，但我不知道我是否可以（或我如何可以）使用这个过滤代码从原来的 'data dump sheet' 中走出来并跳过所有 ColScrub/Sheet1/Sheet2/Sheet3 创建和操作，只需过滤到我需要的确切列数据和条件。

Sub test()
Dim CountLV_Rows As Long
Dim wbActive As Excel.Workbook

Set wbActive = ActiveWorkbook
With wbActive
.Sheets("Temp Data").Range("A:T").ClearContents
CountLV_Rows = .Sheets("Main Sheet").Range("A" & Rows.Count).End(xlUp).Row
.Sheets("Main Sheet").Range("A1", "T" & CountLV_Rows).Copy _
        Destination:=.Sheets("Temp Data").Range("A1", "T" & CountLV_Rows)
With .Sheets("Temp Data")
    .Range("A1", "T" & CountLV_Rows).Sort Key1:=.Range("R1"), Order1:=xlAscending, Header:=xlGuess, _
                                          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                          DataOption1:=xlSortNormal
.Activate
MsgBox "Sorted by R"
    .Range("A1", "T" & CountLV_Rows).Sort Key1:=.Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
                                          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                          DataOption1:=xlSortNormal
End With
End With
End Sub

我在今天的代码中使用了上面的代码，但除了按列排序外，别以为它会做任何其他事情

Answer 1

已编辑：这里是经过测试的代码

Option Explicit

Sub main()
Dim dataRng As Range

With Sheets("ColScrub")
    .Rows(1).Insert 'temporary "header" row to allow for subsequent Autofilter operations

    Set dataRng = Range(Cells(1, 1), .Cells(2, 1).CurrentRegion)
    With dataRng
        .Rows(1).value = "temp header" ' assign temporary headers. no matter they actual value, since autofilter will use columns index
        .AutoFilter field:=5, Criteria1:="In Progress", Operator:=xlOr, Criteria2:="Jeopardy"
        .AutoFilter field:=4, Criteria1:="New Connect"
        .AutoFilter field:=6, Criteria1:="New Connect", Operator:=xlOr, Criteria2:="Change"

        If Application.WorksheetFunction.Subtotal(103, .Columns("A")) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Worksheets("Temp1").Range("A1")

        .AutoFilter 'remove filters
    End With
    .Rows(1).Delete 'remove temporary "header" row

End With

End Sub

将多个 ForEach 和 With 循环清理为单个操作

Cleaning up multiple ForEach and With loops into single action

excel

vba

for-loop

with-statement