Excel VBA性能 - 100萬行 - 在不到1分鐘的時間內刪除包含值的行我試圖在不到一分鐘的時間內找到一種方法來過濾大數據并刪除工作表中的行目標：在第1列中查找包含特定文本的所有記錄，然后刪除整行保持所有單元格格式（顏色，字體，邊框，列寬）和公式。測試數據：：。代碼如何工作：首先關閉所有Excel功能如果工作簿不為空，并且要刪除的文本值存在于第1列中將單元格地址添加到格式的tmp字符串中 "A11,A275,A3900,..."如果tmp變量長度接近255個字符使用刪除行 .Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp將tmp重置為空并繼續(xù)前進到下一組行將列1的已使用范圍復制到數組向后迭代數組中的每個值當找到匹配時：最后，它將所有Excel功能重新打開。主要問題是刪除操作，總持續(xù)時間應低于一分鐘。任何基于代碼的解決方案都是可以接受的，只要它在1分鐘內執(zhí)行即可。這將范圍縮小到極少數可接受的答案。已經提供的答案也非常簡短，易于實施。一個人在大約30秒內執(zhí)行操作，因此至少有一個答案提供了可接受的解決方案，其他人可能會發(fā)現它也很有用。我的主要初始功能：Sub DeleteRowsWithValuesStrings()
Const MAX_SZ As Byte = 240
Dim i As Long, j As Long, t As Double, ws As Worksheet Dim memArr As Variant, max As Long, tmp As String
Set ws = Worksheets(1)
max = GetMaxCell(ws.UsedRange).Row
FastWB True: t = Timer With ws If max > 1 Then
If IndexOfValInRowOrCol("Test String", , ws.UsedRange) > 0 Then
memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2 For i = max To 1 Step -1
If memArr(i, 1) = "Test String" Then
tmp = tmp & "A" & i & ","
If Len(tmp) > MAX_SZ Then
.Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
tmp = vbNullString End If
End If
Next
If Len(tmp) > 0 Then
.Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp End If
.Calculate End If
End If
End With
FastWB False: InputBox "Duration: ", "Duration", Timer - tEnd Sub
3 回答
Smart貓小萌
TA貢獻1911條經驗 獲得超7個贊
如果源數據不包含公式，或者方案允許（或希望）在條件行刪除期間將公式轉換為硬值，則可以實現速度的顯著提高。
以上作為警告，我的解決方案使用范圍對象的AdvancedFilter。它的速度大約是DeleteRowsWithValuesNewSheet（）的兩倍。
Public Sub ExcelHero()
Dim t#, crit As Range, data As Range, ws As Worksheet Dim r&, fc As Range, lc As Range, fr1 As Range, fr2 As Range
FastWB True
t = Timer Set fc = ActiveSheet.UsedRange.Item(1)
Set lc = GetMaxCell Set data = ActiveSheet.Range(fc, lc)
Set ws = Sheets.Add With data Set fr1 = data.Worksheet.Range(fc, fc.Offset(, lc.Column))
Set fr2 = ws.Range(ws.Cells(fc.Row, fc.Column), ws.Cells(fc.Row, lc.Column))
With fr2
fr1.Copy .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAll .Item(1).Select
End With
Set crit = .Resize(2, 1).Offset(, lc.Column + 1)
crit = [{"Column 1";"<>Test String"}]
.AdvancedFilter xlFilterCopy, crit, fr2 .Worksheet.Delete End With
FastWB False
r = ws.UsedRange.Rows.Count
Debug.Print "Rows: " & r & ", Duration: " & Timer - t & " seconds"End Sub
米脂
TA貢獻1836條經驗 獲得超3個贊
在我的老人戴爾Inspiron 1564（Win 7 Office 2007）上：
Sub QuickAndEasy()
Dim rng As Range Set rng = Range("AA2:AA1000001")
Range("AB1") = Now
Application.ScreenUpdating = False
With rng .Formula = "=If(A2=""Test String"",0/0,A2)"
.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete .Clear End With
Application.ScreenUpdating = True
Range("AC1") = NowEnd Sub跑了大概10秒鐘。我假設AA列可用。
編輯＃1：
請注意，此代碼未將“ 計算 ” 設置為“手動”。如果在允許“幫助”列計算后將計算模式設置為手動，則性能將得到改善。
添加回答
舉報
0/150
提交
取消