在 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
• 复制该单元格
• 选择要添加该值的单元格
• 打开选择性粘贴对话框
• 选择“添加”并确定

停止宏记录器。按原样使用该代码或将其用于您的其他代码。

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，但您的数据集足够大，那么它可以更快地读入数组，在数组中进行操作，然后一次性输出该数组。

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