Очистка нескольких объектов ForEach и с циклами в одно действие

Question

Я не получаю результаты поиска, которые соответствуют моим потребностям, и я думаю, что это имеет какое-то отношение к моему использованию слов или условиям. Я в основном ищу подходящее слово для поиска или ссылки на места, чтобы найти, в каком направлении идти дальше. (И не кому-то просто сбрасывать код вниз, я здесь учился ...).

Я надеюсь объединить несколько циклов «Для каждого» и «С» в одно действие, чтобы сэкономить накладные расходы/время на обработку.

В настоящее время я извлекаю данные из основного «листа данных дампа» и копирую необработанные столбцы, которые мне нужны, на листе «Слой столбца». На листе «ColScrub» используйте (по крайней мере) три отдельных цикла «Для каждого», чтобы получить данные, которые были отфильтрованы до того, что мне нужно, что хорошо работает до сих пор, хотя иногда бывает 20+ вторых задержек на вытаскивание/скраб данных и материал, который я теперь ограничиваю расширением в будущем.

Основное изложение состоит в том, что я читаю с листа «ColScrub», и у меня он создает новый лист Temp и вставляет некоторые отфильтрованные данные в Temp1.

После этого я затем прочитал от Temp1 и «For Each» снова, чтобы вставить дополнительно отфильтрованные данные на новый лист Temp2.

Наконец, я затем прочитал из Temp2 и использовал другой цикл «Для каждого» для дальнейшего фильтрации и затем вставки данных в Temp3.

У Temp3 по существу есть «чистые данные», которые мне нужны, и оттуда запускать другие vba или формулы из этих очищенных данных, чтобы предоставить презентабельные данные.

Фрагмент кода, чтобы получить от «данных дампа листа» к населенному TempSheet3:

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) и из этих данных столбца, чтобы затем фильтровать ColE только для элементов в статусе «Выполняется» или «Опасность», а также из ColD только для элементов в статусе «Новый Connect», а также для ColF для элементов в «NewConnect» или 'Изменить статус.

Есть ли способ я могу получить фильтры Cole/хол/Colf всем, быть в одном шаге (и возможно добавить вещи для фильтрации как ColAA для диапазона дат и ColAB для текста и т.д.)

Если имеет смысл.

Затем я нашел некоторые элементы фильтрации, которые ниже, но я не знаю, могу ли я (или как я могу) использовать этот код фильтра, чтобы перейти от исходного «листа данных данных» и пропустить все создание и манипулирование 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 

Я получил выше, чтобы работать в моем коде, поскольку это стоит сегодня, но не htink он ничего не делает, кроме рода колоннами

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