我有一張近 100000 行和 A 到 Q 列的作業表，如果 Q 列有空白單元格，我有一個代碼可以洗掉整行。
我已經在 4000 行上嘗試了這段代碼，它在 3 分鐘內運行，但是當我使用 100000 行時，它只處理了幾個小時。
如果有一些幫助/指導我加快這段代碼的速度，我會非常滿意。
代碼是：
Sub DeleteBlank()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lo As ListObject
set lo = sheets("BOM 6061").ListObjects(1)
Sheets("BOM 6061").Activate
lo.AutoFilter.ShowAllData
lo.range.AutoFilter Field:=17, Criteria1:=""
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
lo.DataBodyRange.SpecialCells(xlCellsTypeVisible).Delete
Application.DisplayAlerts = True
lo.AutoFilter.ShowAllData
End Sub
uj5u.com熱心網友回復：
有效地洗掉 Excel 表中的條件行
- 簡而言之，如果您不對條件列進行排序，洗掉行可能需要“永遠”。
- 以下將做到這一點，保持剩余行的初始順序。
Option Explicit
Sub DeleteBlankRows()
Const wsName As String = "BOM 6061"
Const tblIndex As Variant = 1
Const CriteriaColumnNumber As Long = 17
Const Criteria As String = ""
' Reference the table.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim tbl As ListObject: Set tbl = ws.ListObjects(tblIndex)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Remove any filters.
If tbl.ShowAutoFilter Then
If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
Else
tbl.ShowAutoFilter = True
End If
' Add a helper column and write an ascending integer sequence to it.
Dim lc As ListColumn: Set lc = tbl.ListColumns.Add
lc.DataBodyRange.Value = _
ws.Evaluate("ROW(1:" & lc.DataBodyRange.Rows.Count & ")")
' Sort the criteria column ascending.
With tbl.Sort
.SortFields.Clear
.SortFields.Add2 tbl.ListColumns(CriteriaColumnNumber).Range, _
Order:=xlAscending
.Header = xlYes
.Apply
End With
' AutoFilter.
tbl.Range.AutoFilter Field:=CriteriaColumnNumber, Criteria1:=Criteria
' Reference the filtered (visible) range.
Dim svrg As Range
On Error Resume Next
Set svrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
' Remove the filter.
tbl.AutoFilter.ShowAllData
' Delete the referenced filtered (visible) range.
If Not svrg Is Nothing Then svrg.Delete
' Sort the helper column ascending.
With tbl.Sort
.SortFields.Clear
.SortFields.Add2 lc.Range, Order:=xlAscending
.Header = xlYes
.Apply
.SortFields.Clear
End With
' Delete the helper column.
lc.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
' Inform.
MsgBox "Blanks deleted.", vbInformation
End Sub
uj5u.com熱心網友回復：
我不會在大型資料集上使用自動過濾器，因為在實際過濾資料之前，它們可能會花費大量時間來嘗試列舉可用選項。AutoFilter.ShowAllData 需要同樣多的時間。對于我的超級簡單的測驗資料集，它由 26 列 1000000 行組成，每個處理需要 30 多秒。
據我所知，您正在過濾串列以僅顯示空白專案，然后洗掉空白行。由于過濾是導致延遲的原因，我們可以遍歷每一行查看特定列，如果它是空白的，你可以洗掉它。以下是如何執行此操作的示例。
**編輯：經過測驗，我發現這比您想要的要慢得多。查看下面的下一個示例，因為它非常快。
Option Explicit
Sub DeleteBlank()
Application.ScreenUpdating = False
Dim calcType As Integer
Dim rowCount, columnNumToCheck, currow, dataStartRow As Long
Dim WkSht As String
Dim lo As ListObject
WkSht = "BOM 6061" 'The name of the worksheet where the table is located.
columnNumToCheck = 17 'The column number to check for blank cells.
calcType = Application.Calculation
Application.Calculation = xlCalculationManual
Set lo = Sheets(WkSht).ListObjects(1)
rowCount = lo.ListRows.Count
dataStartRow = (lo.DataBodyRange.Row - 1)
For currow = rowCount To 1 Step -1
If Sheets(WkSht).Cells((currow dataStartRow), columnNumToCheck).Value = "" Then
Call DeleteRows(WkSht, (currow dataStartRow))
End If
Next currow
Application.Calculation = calcType
Application.ScreenUpdating = True
End Sub
Private Sub DeleteRows(sheetNameIn As String, startRow As Long, Optional optionalEndRow As Long)
If IsNull(optionalEndRow) Or optionalEndRow = 0 Then
optionalEndRow = startRow
End If
Worksheets(sheetNameIn).Range(startRow & ":" & optionalEndRow).Delete Shift:=xlUp
End Sub
如果您能夠對空白單元格都在一起的資料進行排序，則可以使用以下命令執行單個洗掉功能，一次將它們全部洗掉。這在幾秒鐘內洗掉了 70000 行。
Sub DeleteBlankWithSort()
'Application.ScreenUpdating = False
Dim columnNumToCheck, tableLastRow, lrow As Long
Dim calcType As Integer
Dim WkSht As String
Dim lo As ListObject
WkSht = "BOM 6061" 'The name of the worksheet where the table is located.
columnNumToCheck = 17 'The column number to check for blank cells.
calcType = Application.Calculation
Application.Calculation = xlCalculationManual
Set lo = Sheets(WkSht).ListObjects(1)
tableLastRow = FindLastRow(WkSht, (columnNumToCheck))
With lo.Sort
.SortFields.Clear
.SortFields.Add _
Key:=Range("Table1[[#All],[q]]"), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lrow = FindLastRow(WkSht, (columnNumToCheck), (tableLastRow))
Call DeleteRows(WkSht, (tableLastRow), (lrow 1))
Application.Calculation = calcType
Application.ScreenUpdating = True
End Sub
Private Sub DeleteRows(sheetNameIn As String, startRow As Long, Optional optionalEndRow As Long)
If IsNull(optionalEndRow) Or optionalEndRow = 0 Then
optionalEndRow = startRow
End If
Worksheets(sheetNameIn).Range(startRow & ":" & optionalEndRow).Delete Shift:=xlUp
End Sub
Private Function FindLastRow(sheetNameIn As String, columnNum As Long, Optional optionalStartRow As Long) As Long
'finds the last row of the column passed in the sheetname passed in
If IsNull(optionalStartRow) Or optionalStartRow = 0 Then
optionalStartRow = 1048576
End If
FindLastRow = Worksheets(sheetNameIn).Range(Cells(optionalStartRow, columnNum).Address).End(xlUp).Row
End Function
uj5u.com熱心網友回復：
不久前我有一個簡單的例子。高級過濾是就地過濾或在 excel/vba 中過濾和復制的最快方法。在高級過濾中，您通常會在列/行中列出您的過濾器，并且可以根據需要設定任意數量的過濾器，使用 >"" 過濾掉列上的空白，根本不需要時間。在我的示例中，它可能會有所不同，因為如果將任何內容添加到過濾器中，則它與 sheetchange 一起用于自動過濾。
Sub Advanced_Filtering_ModV2()
Dim rc As Long, crc As Long, trc As Long
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook: Set ws = wb.Worksheets("sheet1")
ws.Range("AA1").Value = ws.Range("Q1").Value: ws.Range("AA2").Value = ">"""""
On Error Resume Next
ws.ShowAllData: rc = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A1:V" & rc).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ws.Range("AA1:AA2")
On Error GoTo 0
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/492101.html