我正在使用Sub来帮助清理我需要每周工作的大型数据集。数据是一个产品列表，每个产品的总数和大小，所以它看起来像这样：
产品1全部
产品1小
产品1中等
产品2全部
我只想保留一个产品，如果它符合3个标准中的一个，但如果是，我想保留该产品的所有行。如果产品不符合3个标准中的任何一个，我想删除具有该产品的每一行。
我已经编写了以下代码，这似乎有效，但需要很长时间。
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行，我知道我一遍又一遍地重复它，但我不知道更好的方法来更快地完成它。非常感谢任何帮助。
答案 0 :(得分：2)
我的一般建议是创建一个字典，这是一个可以使用有序索引号或名称键访问的值数组。使用该字典，首先浏览所有数据行。看E栏：“E”和“E”中的名字吗？我还在字典中存在吗？如果没有，请将其添加到字典中。然后获取字典ID（新创建的或在前一行创建的字典ID），并将包含K，L和O列的行添加到字典条目的值中。
然后，一旦您使用字典收集了所有名称，并且已经添加了列K，L和O，则返回所有行（从下到上）。对于该行的索引ID，是字典条目中的值＆gt; 0？如果是，请删除该行。
但是为了使事情复杂化，您需要添加一个单独的（免费的，支持微软的）脚本包来使用字典。相反，我们将自己制作。这意味着每次检查新行的唯一名称时，我们需要循环遍历唯一名称列表，并单独检查每个名称，而不是使用该名称作为索引。请参阅下面的修订代码，并对您所做的更改发表评论。请注意，我在开头设置了所有变量，包括将数据声明为= 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
根据Trey博士的建议，您还可以在处理过程中消除自动更新等，以进一步节省操作时间。
答案 1 :(得分：1)
这是另一种方法。此方法不是手动循环并检查匹配的供应商名称中的值，而是使用每行上的本机Excel SUMIFS函数来查看是否有任何匹配的行具有值。然后通过布尔值数组为每一行指定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