VBA Faster Data Clean Up

Question

Я работаю над Sub, чтобы помочь очистить большой набор данных Мне нужно работать каждую неделю. данные список продуктов, с общим и размер для каждого, так это выглядит примерно так:

Продукт 1 Все

Продукт 1 Малый

Продукт 1 Средний

Продукт 2 Все

Я хочу сохранить продукт только в том случае, если он соответствует одному из трех критериев, но если это так, я хочу сохранить все строки для этого продукта. Если продукт не соответствует ни одному из трех критериев, я хочу удалить каждую строку, содержащую этот продукт.

Я написал приведенный ниже код, который, кажется, работает, но занимает много времени.

For i = Data.Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1 
If Data.Range("F" & i) = "All" Then 

    TY_Sales = Data.Range("K" & i) 
    LY_Sales = Data.Range("L" & i) 
    TY_Stock = Data.Range("O" & i) 
    Sales_Stock = TY_Sales + LY_Sales + TY_Stock 

    If Sales_Stock <= 0 Then 
    vendor_ref = Data.Range("E" & i) 
     For j = i + 10 To i Step -1 
      If Data.Range("E" & j) = vendor_ref Then 
      Data.Range("E" & j).EntireRow.Delete 
      End If 
     Next 
    End If 
End If 
Next 

Его принимают возрастов, потому что мой первоначальный набор данных 17k строк, и я знаю, что я итерация через все это снова и снова, но я не знаю, лучший способ сделать это быстрее. Любая помощь приветствуется.

Answer 1

Моим общим советом было бы создать словарь, который представляет собой массив значений, к которым можно получить доступ либо с упорядоченным номером индекса, либо с помощью имени. С помощью этого словаря сначала просматривайте все строки данных. Посмотрите столбец E: имя в «E» & i еще есть в словаре? Если нет, добавьте его в словарь. Затем возьмите идентификатор словаря (только что созданный или созданный в предыдущей строке) и добавьте эту строку со столбцами K, L и O в значение словаря.

Затем, как только у вас есть все имена, собранные со словарем, и вы добавили столбцы K, L и O, вернитесь ко всем строкам (снизу вверх). Для идентификатора индекса этой строки является значение из словаря> 0? Если да, удалите эту строку.

Но, чтобы усложнить ситуацию, вам нужно добавить отдельный (бесплатный, поддерживаемый Microsoft) скриптовый пакет, чтобы использовать словари. Поэтому вместо этого мы сделаем свои. Единственное, что это означает, состоит в том, что каждый раз, когда новая строка проверяется на уникальное имя, нам нужно циклически перебирать список уникальных имен таким образом и проверять каждый отдельно, вместо того, чтобы использовать это имя в качестве индекса. См. Мой пересмотренный код ниже, с комментариями об изменениях, сделанных с вашего. Обратите внимание, что я установил все переменные в начале, включая объявление Data to = sheet (1), которое может отличаться от вашего sub.

Sub Delete_Unnecessary_Rows() 

Dim i As Integer 
Dim TY_Sales As Long, LY_Sales As Long, TY_Stock As Long, Sales_Stock As Long, LastRow As Long 
Dim data As Worksheet 
Dim vendor_ref As String 

Dim VendorStringArray() As String 'This Array will hold all unique vendor names 
Dim VendorNumArray() As Long 'This array will hold the Sales Stock value for each unique vendor name 
Dim VendorRowIdentifier() As Long 'For each row, this will hold the index for particular unique vendor name 
Dim UniqueNameCounter As Long 'This will hold the number of confirmed unique names 

Dim UniqueCheck As Boolean 


Set data = Sheets(1) 

LastRow = data.Cells(data.Rows.Count, "B").End(xlUp).Row 

ReDim VendorStringArray(3 To LastRow) 'resize the array to be the full possible amount of unique string values 
ReDim VendorNumArray(3 To LastRow) 
ReDim VendorRowIdentifier(3 To LastRow) 

For i = 3 To LastRow 'new loop to find new dictionary names 
    If data.Range("F" & i) = "All" Then 'This is a data row to be searched for a unique vendor name 

     UniqueCheck = True 'Holds TRUE until a duplicate value is found in a higher row 

     vendor_ref = data.Range("E" & i).Formula 'Grabs the vendor name and Sales_Stock amount for that row 
     TY_Sales = data.Range("K" & i) 
     LY_Sales = data.Range("L" & i) 
     TY_Stock = data.Range("O" & i) 
     Sales_Stock = TY_Sales + LY_Sales + TY_Stock 
     If UniqueNameCounter > 0 Then 'If there's already been at least 1 unique name, check prior unique names to try and find a match 

      For j = UniqueNameCounter To 1 Step -1 'works backwards through prior unique counters to find a match 
       If vendor_ref = VendorStringArray(j + 2) Then 
        UniqueCheck = False 'A match has been found 
        VendorRowIdentifier(i) = j + 2 'associates the row being searched with the index of the unique vendor name for the matched row 
        VendorNumArray(VendorRowIdentifier(i)) = VendorNumArray(VendorRowIdentifier(i)) + Sales_Stock 'adds the new sales stock value to the old one with that unique vendor name 
        j = 0 'stops the formula from looping after a match is found 

       End If 
      Next j 
     End If 
     If UniqueCheck Then 'no match was found for that name in an above row 
       UniqueNameCounter = UniqueNameCounter + 1 
       VendorStringArray(UniqueNameCounter + 2) = vendor_ref 'adds the text to be matched against future values in the array, starting at 3 instead of 1 
       VendorRowIdentifier(i) = UniqueNameCounter + 2 'associates the row being searched with the index of the unique vendor name 
       VendorNumArray(UniqueNameCounter + 2) = Sales_Stock 
     End If 
    End If 

Next i 


For i = LastRow To 3 Step -1 'After determining which rows have values, delete all such rows 
    If data.Range("F" & i) = "All" Then 
     If VendorNumArray(VendorRowIdentifier(i)) > 0 Then 'Pull the value of the unique vendor name associated with that row #'s vendor and check the size associated 
      data.Rows(i).Delete 'Delete the row if any value has been assigned to that vendor 
     End If 
    End If 
Next 


End Sub 

Как предположил доктор Трей, вы можете также исключить автоматическое обновление и т.д. во время обработки, чтобы дополнительно сэкономить время в работе.

Answer 2

Вот альтернативный метод. Вместо ручного циклирования и проверки значений в сопоставлении имен поставщиков этот метод использует собственную функцию SUMIFS для Excel в каждой строке, чтобы увидеть, имеют ли соответствующие строки значения. Затем каждой строке присваивается значение TRUE или FALSE через массив логических значений. Затем цикл выполняется снова, и строки с пометкой TRUE удаляются. Этот метод проходит только через все строки 2x, хотя использование SUMIFS может быть более интенсивным, чем ручной цикл выше. Однако я считаю, что этот метод легче понять.

Раскрытие информации: Я протестировал оба метода и подтвердил, что они работают, но не уверены в том, какова будет разница во времени обработки.

Sub CheckDelete_WithSumifs() 

Dim i As Integer 
Dim TY_Sales As Long, LY_Sales As Long, TY_Stock As Long, Sales_Stock As Long, LastRow As Long 
Dim data As Worksheet 
Dim Vendor_Ref As String 
Dim DeleteRowCheck() As Boolean 

Set data = Sheets(1) 

LastRow = data.Cells(data.Rows.Count, "B").End(xlUp).Row 

ReDim DeleteRowCheck(3 To LastRow) 'resize the array to be the full possible amount of unique string values 

For i = LastRow To 3 Step -1 'new loop to find new dictionary names 
    If data.Range("F" & i) = "All" Then 'Only check to delete if the word All is in column F 

     Vendor_Ref = data.Range("E" & i).Formula 'Grabs the vendor name and Sales_Stock amount for that row 
     TY_Sales = GrabSumifs(data.Range("K:K"), Vendor_Ref, data) ' See function below 
     LY_Sales = GrabSumifs(data.Range("L:L"), Vendor_Ref, data) 
     TY_Stock = GrabSumifs(data.Range("O:O"), Vendor_Ref, data) 

     Sales_Stock = TY_Sales + LY_Sales + TY_Stock 'Total value of all columns K, L, O for that vendor name 

     If Sales_Stock > 0 Then 
      DeleteRowCheck(i) = True 'Used in the loop below to define whether to delete the row 
     Else 
      DeleteRowCheck(i) = False 
     End If 
    End If 

Next i 

For i = LastRow To 3 Step -1 'After determining which rows have are marked TRUE to delete, delete those rows 
    If DeleteRowCheck(i) Then 
     data.Rows(i).Delete 'Delete the row if any value has been assigned to that vendor 
    End If 
Next 


End Sub 

Function GrabSumifs(SumRange, Vendor_Ref, data) As Long 

'This function uses the SUMIFS formula native to Excel, to check the given column to see if any values are present with an identicial vendor name & "All" in column F. 
GrabSumifs = Application.WorksheetFunction.SumIfs(SumRange, data.Range("F:F"), "All", data.Range("E:E"), Vendor_Ref) 

End Function