如何检查范围VBA单元格的值

我试图采取一系列的单元格（列B是具体的），并find该范围内的值小于零的单元格，并清除这些单元格的内容。 有没有办法做到这一点没有循环通过每一个单元格？ 该列是一个非常大的数据集，每周都会变得更长，因此循环需要大量的时间。

下面是我正在使用的当前循环

Dim sht As Worksheet Dim LastColumn As Long Set sht = ThisWorkbook.Worksheets("Sheet1") lastrow = sht.Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row for i=1 to lastrow if sheets("time").cells(i, "B") then sheets("time").cells(i, "B").clear end if next i 

我试图检查，然后删除包含公式的单元格

编辑：标记为接受的答案加快了过程，但仍然需要一个循环。 如果有人有什么比发布更快，可以自由地添加它。

Answer 1

根据我的评论。 我在5万行上运行，花了很less的时间。

 Option Explicit Sub update_column() Dim Column_to_run_on As String Dim LR As Long, i As Long Dim arr As Variant 'change as needed Column_to_run_on = "D" 'change sheet as needed With Sheets("Sheet1") LR = .Range(Column_to_run_on & "1048575").End(xlUp).Row '"2:" here as I assume you have a header row so need to start from row 2 arr = .Range(Column_to_run_on & "2:" & Column_to_run_on & LR) For i = 1 To UBound(arr, 1) If arr(i, 1) < 0 Then arr(i, 1) = 0 End If Next .Range(Column_to_run_on & "2:" & Column_to_run_on & LR).Value = arr End With End Sub 

Answer 2

不需要循环。 假设我们有从B1到B21的数据，如：

这个微小的macros：

 Sub RemoveNegs() With Range("B1:B21") .Value = Evaluate("IF(" & .Address & " < 0,""""," & .Address & ")") End With End Sub 

会产生：

如果单元格包含公式，则不适用。

Answer 3

我testing了与vbaarrays对两种解决schemelopps，循环至less2至5倍在每种情况下：

 Option Explicit Sub fill() Dim t As Double t = Timer Dim x& Dim y& Dim arr() With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual ReDim arr(1 To 2000, 1 To 1000) For x = 1 To 1000 For y = 1 To 2000 arr(y, x) = Rnd() * 1111 - 555 Next y Next x Range(Cells(1, 1), Cells(2000, 1000)).Value2 = arr .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True Debug.Print Timer - t End With Erase arr End Sub Sub nega() Dim t As Double t = Timer Dim x& Dim y& Dim arr() With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual 'With Range("A1", Cells(2000, 1000)) ' .Value2 = Evaluate("if(" & .Address & " <0,""""," & .Address & ")") 'End With 'Range(Cells(1, 1), Cells(2000, 1000)).Replace "-*", "" arr = Range(Cells(1, 1), Cells(2000, 1000)).Value2 For x = 1 To 1000 For y = 1 To 2000 If arr(y, x) < 0 Then arr(y, x) = vbNullString Next y Next x Range(Cells(1, 1), Cells(2000, 1000)).Value2 = arr .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True End With Erase arr Debug.Print Timer - t End Sub