Question

我目前正在尝试编写如下的VBA代码。但是，当我从“another_ws”中提取值时，需要永远更新每个值。这样做有更快的方法吗？代码需要几个小时才能运行。

Dim another_ws as worksheet
Set another_ws = wb.sheets("sheet1") 

For row = 1 To 500
    For column = 1 To 500
        ws.cells(row, column).value = _ 
        ws.cells(row, column).value + another_ws.cells(row, column).value
        'another_ws comes from another workbook
    Next column
Next row

Answer 1

有两种不同的方法：

WorkSheet.Evaluate：

Dim another_ws As Worksheet
Set another_ws = wb.Sheets("sheet1")
ws.Range("A1").Resize(500, 500).Value = ws.EVALUATE("INDEX(" & ws.Range("A1").Resize(500, 500).Address(1, 1) & _
    " + " & another_ws.Range("A1").Resize(500, 500).Address(1, 1, xlA1, True) & ",)")

使用数组：

Dim another_ws As Worksheet
Set another_ws = wb.Sheets("sheet1")    
Dim oarr() As Variant
Dim tarr() As Variant

oarr = ws.Range("A1").Resize(500, 500).Value
tarr = another_ws.Range("A1").Resize(500, 500).Value

For i = 1 To 500
    For j = 1 To 500
        oarr(i, j) = oarr(i, j) + tarr(i, j)
    Next j
Next i

ws.Range("A1").Resize(500, 500).Value = oarr

或者@ Gary的学生说，PasteSpecial Add：

Dim another_ws As Worksheet
Set another_ws = wb.Sheets("sheet1")

another_ws.Range("A1").Resize(500, 500).Copy
ws.Range("A1").Resize(500, 500).PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd

Answer 2

只是不要使用循环：

Sub WhatEver()
    Dim r1 As Range, r2 As Range

    Set r1 = Sheets("Sheet1").Range("A1:SF500")
    Set r2 = Sheets("Sheet2").Range("A1:SF500")

    r2.Copy
    r1.PasteSpecial xlPasteSpecialOperationAdd
End Sub

Answer 3

你的跑步是否在ws和anther_ws之间来回闪烁？这个可视化更新可以在计算机循环时，因为屏幕在获取值时绘制每个工作表。

您可以尝试在代码开头关闭更新，然后在最后重新开启。

Application.ScreenUpdating = False

VBA立刻粘贴一块细胞

3 个答案: