excel - 700K 行数据的功能非常慢

Question

使用以下函数在短数据上表现良好，但每当我移动大型数据集时，处理时间很长，有时会卡住。
如果有另一种更快的方法来执行此操作，我将不胜感激。

Sub minustozeo()
Dim c As Range
For Each c In Selection.SpecialCells(xlCellTypeVisible)
 If c.Value < 0 Then
 c.Value = 0
 End If
Next
End Sub

Answer 1

这是使用数组方法的更快方法:

Sub Tester()
    
    Dim ws As Worksheet, c As Range, t, rngVis As Range, rngVals As Range
    Dim arr, r As Long
    
    Set ws = ActiveSheet
    Set rngVals = ws.Range("A2:A500000") 'range to operate on
    
    'create some dummy data with about 70% < 0
    If ws.FilterMode Then ws.ShowAllData
    With rngVals
        .Formula = "=RAND()-0.7"
        .Value = .Value
    End With
    
    rngVals.Copy rngVals.Offset(, 2) 'for verification only...
    
    'autofilter
    rngVals.AutoFilter Field:=1, Criteria1:="<0", Operator:=xlAnd
        
    On Error Resume Next
    Set rngVis = rngVals.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If rngVis Is Nothing Then Exit Sub 'no cells found
    
    Debug.Print rngVis.Cells.Count 'approx 350k
    
    t = Timer
    arr = rngVals.Value 'read the data
    For Each c In rngVis.Cells
        If c.Value < 0 Then arr(c.Row - 1, 1) = 0 ' -1 because first array value is from row #2
    Next c
    rngVals.Value = arr     'write the altered data back
    Debug.Print Timer - t   ' ~1 sec
    
    ws.ShowAllData

End Sub