在 VBA 中不使用 for 循環，每行加 1

Question

尋找一種簡單的方法將某個數字添加到列中的每一行。 像range("b1:b9")=range("a1:a9")+1

由此：

對此：

Answer 1

您可以使用 Evaluate，似乎很快。

Sub Add1()

    With Range("A1:A10000")
        .Value = Evaluate(.Address & "+1")
    End With

End Sub

Answer 2

尋找“省時”的解決方案和避免循環不是一回事。

如果您要遍歷范圍本身，那么是的，它會很慢。 將范圍數據復制到 Variant 數組，循環，然后將結果復制回范圍很快。

這是一個演示

Sub Demo()
    Dim rng As Range
    Dim dat As Variant
    Dim i As Long
    Dim t1 As Single
    
    t1 = Timer() '  just for reportingh the run time
    
' Get a reference to your range by whatever means you choose.  
' Here I'm specifying 1,000,000 rows as a demo
    Set rng = Range("A1:A1000000")
    dat = rng.Value2
    For i = 1 To UBound(dat, 1)
        dat(i, 1) = dat(i, 1) + 1
    Next
    rng.Value2 = dat
    
    Debug.Print "Added 1 to " & UBound(dat, 1) & " rows in " & Timer() - t1; " seconds"
End Sub

在我的硬件上，這運行大約 1.3 秒

_{僅供參考，PasteSpecial，添加技術仍然更快}

Answer 3

啟動宏記錄器。

• 在空單元格中輸入 1
• 復制該單元格
• select 要添加該值的單元格
• 打開選擇性粘貼對話框
• select“添加”並確定

停止宏記錄器。 按原樣使用該代碼或將其用於您的其他代碼。

Range("C1").Value = 1
Range("C1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1:A5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= False, Transpose:=False

Answer 4

增加范圍值

• 在以下示例中， Add解決方案需要 2.4 秒，而Array解決方案需要 8.7 秒（在我的機器上）來處理 5 列。
• 在Array解決方案中，選擇永遠不會改變，它只是將結果寫入范圍。
• Add解決方案有點模仿這種行為，將所有選擇設置為最初的樣子。 因此出現了並發症。

Option Explicit

' Add Solution

Sub increaseRangeValuesTEST()
    increaseRangeValues Sheet1.Range("A:E"), 1 ' 2.4s
End Sub

Sub increaseRangeValues( _
        ByVal rg As Range, _
        ByVal Addend As Double)
    
    Application.ScreenUpdating = False
    
    Dim isNotAW As Boolean: isNotAW = Not rg.Worksheet.Parent Is ActiveWorkbook
    Dim iwb As Workbook
    If isNotAW Then Set iwb = ActiveWorkbook: rg.Worksheet.Parent.Activate
    
    Dim isNotAS As Boolean: isNotAS = Not rg.Worksheet Is ActiveSheet
    Dim iws As Worksheet
    If isNotAS Then Set iws = ActiveSheet: rg.Worksheet.Activate
    
    Dim cSel As Variant: Set cSel = Selection
    Dim aCell As Range: Set aCell = ActiveCell
    Dim sCell As Range: Set sCell = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim sValue As Double: sValue = sCell.Value + Addend
    
    sCell.Value = Addend
    sCell.Copy
    
    rg.PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd ' 95%
    Application.CutCopyMode = False
    sCell.Value = sValue
    aCell.Activate
    cSel.Select
    
    If isNotAS Then iws.Activate
    If isNotAW Then iwb.Activate
    
    Application.ScreenUpdating = True

End Sub


' Array Solution    

Sub increaseRangeValuesArrayTEST()
    increaseRangeValuesArray Sheet1.Range("A:E"), 1 ' 8.7s
End Sub

Sub increaseRangeValuesArray( _
        ByVal rg As Range, _
        ByVal Addend As Double)
    
    With rg
        Dim rCount As Long: rCount = .Rows.Count
        Dim cCount As Long: cCount = .Columns.Count
        Dim Data As Variant
        If rCount > 1 Or cCount > 1 Then
            Data = .Value
        Else
            ReDim Data(1 To 1, 1 To 1): Data = .Value
        End If

        Dim r As Long, c As Long
        For r = 1 To rCount
            For c = 1 To cCount
                Data(r, c) = Data(r, c) + Addend
            Next c
        Next r
        .Value = Data ' 80%
    End With

End Sub

Answer 5

#1。 禁用自動計算

Application.Calculation = xlCalculationManual

#2。 禁用屏幕更新

Application.ScreenUpdating = False

#3。 只要您的行條目不超過〜56000，但是您的數據集足夠大，那么它可以更快地讀入數組，在數組中進行操作，然后output將該數組放在一個go中。

array1 = Range(cells(3,2), cells(12,2)).value

for i = 1 to ubound(array1, 1)
    array1(i, 1) = array(i, 1) + 1
next i

range(cells(3,10), cells(12,10)) = array1

請注意，array1 將是 2D，在上面的示例中，您將尋址 (1,1) 到 (10,1)

然后在粘貼回來后，重新啟用你的自動計算，然后你的屏幕更新

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True