加快VBA marco

我有一个可以工作的macros，当有大量数据的时候，它真的很慢，我希望在这里有人能帮我加快速度。

当我的VBA做的是检查工作表的列的值为“NULL”，如果它在那里清除该单元格。 代码如下：

Sub RemoveNullColumn() Dim c, count, r, lc, FirstCell Application.ScreenUpdating = False count = 0 r = ActiveCell.row 'lets you choose where you want to start even if it is not at "A1" c = ActiveCell.Column 'lets you choose where you want to start even if it is not at "A1" c = GetLetterFromNumber(c) 'Gets the column letter from the number provided above FirstCell = c & r 'sets the cell that you selected to start in so that you will end thereafter removing all the NULL lc = ActiveSheet.Cells(1, Columns.count).End(xlToLeft).Column 'Finding the last used column For H = ActiveCell.Column To lc Step 1 'Starts with where you selected a cell and moves right to the last column For x = 1 To Range(c & Rows.count).End(xlUp).row Step 1 'Starts with the first row and moves through the last row count = count + 1 If Range(c & x).Value = "NULL" Then 'Checks the contents fo the cell to see if it is "NULL" Range(c & x).Clear End If If count = 1000 Then 'This was used testing but is not seen with the ScreenUpdating set to false Range(c & x).Select count = 1 End If Next x ActiveCell.Offset(0, 1).Select 'select the next column c = ActiveCell.Column c = GetLetterFromNumber(c) 'get the letter of the next column Next H Application.ScreenUpdating = True MsgBox "Finished" Range(FirstCell).Select End Sub Function GetLetterFromNumber(Number) GetLetterFromNumber = Split(Cells(1, Number).Address(True, False), "$")(0) End Function 

当行数不多时，速度相当快，但是行数很多，速度很慢。

我有一个文件，我运行它有从A到AD和61k +行的列，花了超过30分钟才能完成，我希望做得更快。

Answer 1

而不是查看工作表中的每一个单元格，使用更快的replacefunction:(你可能需要编辑它定制它，以满足您的需求）

例如：

 Sub RemoveNullColumn() Dim targetSheet As Worksheet Set targetSheet = ActiveSheet 'TODO: replace with a stronger object reference targetSheet.Cells.Replace What:="NULL", Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub 

这将确保您将保存格式。

Answer 2

如果你想使用ActiveCell作为参考清除NULL ：

 Range(ActiveCell, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Replace What:="NULL", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _ ReplaceFormat:=False 

Answer 3

请给这个尝试…

 Sub RemoveNullColumn() Dim lr As Long, lc As Long Dim rng As Range, cell As Range, FirstCell As Range With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lc = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set FirstCell = ActiveCell Set rng = Range(Cells(1, FirstCell.Column), Cells(lr, lc)) For Each cell In rng If cell.Value = "NULL" Then cell.Clear End If Next cell With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With MsgBox "Finished" End Sub 

Answer 4

使用.Find / .FindNext将所有匹配的单元格收集到一个联合中，然后清除联合单元格的内容。

 Option Explicit Sub noNULLs() Dim firstAddress As String, c As Range, rALL As Range With ActiveSheet.Cells 'This should be named worksheet like Worksheets("sheet1") Set c = .Find("NULL", MatchCase:=True, _ LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then Set rALL = c firstAddress = c.Address Do Set rALL = Union(rALL, c) Set c = .FindNext(c) Loop While c.Address <> firstAddress rALL.Clear End If End With End Sub