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

【问题标题】：How to Check Value of Cells in Range VBA如何检查范围VBA中单元格的值
【发布时间】：2017-06-19 15:32:24
【问题描述】：

我正在尝试获取一个单元格范围（具体为 B 列）并找到该范围内值小于零的单元格并清除这些单元格的内容。有没有办法在不遍历每个单元格的情况下做到这一点？该列是一个非常大的数据集，每周都会变长，因此循环需要大量时间。

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

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

我尝试检查然后可能删除的单元格包含公式

编辑：标记为已接受的答案加快了进程，但仍需要循环。如果有人有任何比发布的内容更快的内容，请随时添加。

【问题讨论】：

您可以将数据读入一个数组，然后将任何小于零的值更改为空（或“”），然后重新输出该列。运行时间应少于 1 秒
也许在问题中添加您现有的循环代码。
我看不出循环不是您的最佳选择。
我知道你标记了VBA，但你也可以在单元格上放置一个过滤器，过滤掉所有正值，然后清除剩余的可见单元格
@BruceWayne 我想过这个问题，但是我每周更新工作簿并且已经有一些 VBA 并且在我完成后很快就会传递给某人。由于很少需要手动操作，所以我试图找到一种自动化的方式来完成它。

标签： vba excel excel-2010

【解决方案1】：

根据我的评论。我在 50k 行上运行它，花费了很少的时间。

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

【讨论】：

【解决方案2】：

不需要循环。假设我们在 B1 到 B21 中有数据，例如：

这个小宏：

Sub RemoveNegs()

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


End Sub

将产生：

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

【讨论】：

【解决方案3】：

我用 vba 数组针对这两种解决方案测试了 lopps，在每种情况下循环至少快 2 到 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

【讨论】：