excel - 在工作表之间高效复制和粘贴信息

Question

我在 Excel 中有以下 VBA 代码，它基本上更新工作表 1 中的数据，然后将粘贴信息从工作表 1 逐一复制到工作表 2。它工作正常，但问题是运行时间比正常情况要长一些。有没有办法让这段代码更高效？

Sub test()

Dim str As Integer
Dim ctr As Integer
ctr = 1

Sheets("Sheet1").Select
str = Range("A1", Range("A1").End(xlDown)).Rows.Count
str = str + 1

Worksheets("Sheet2").Range("A2:c5000").Clear

While ctr < str

    Sheets("Sheet1").Select
    Range("A" & counter).Copy Range("E1")
    Range("K4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    ctr = ctr + 1
Wend


End Sub

Answer 1

这是对您的代码的重写，其中的缺点(如我上面的评论中提到的)以及所有内容，意味着其功能没有改进。

Sub Test_2()

    ' declare row numbers as Long because the Integer data type can't
    ' hold the value of the last row number in a sheet
    Dim R       As Long         ' loop counter: Row
    Dim Rng     As Range        ' loop object:
    Dim Rcount  As Long         ' Rows: count
    Dim Ccount  As Long         ' Columns: count
    
    ' No need to Select anything
    Sheet2.Columns("A:C").ClearContents
    
    ' use a For / Next loop to call up each row number
    '    Next R advances R to the next integer
    For R = 1 To Sheet1.Range("A1", Range("A1").End(xlDown)).Rows.Count
    
        ' (not useful but instructive)
        Sheet1.Range("E1").Value = Sheet1.Cells(R, "A").Value
        
        ' Range("K4") is difficult to handle in a loop.
        ' Better use Cells(4, "K") and better still, Cells(4, 11)
        '   where both 4 and 11 can be calculatable variables.
        ' Here the range is fixed to K4 and can't change in the loop.
        Ccount = Sheet1.Range("K4").End(xlToRight).Column - Columns("K").Column + 1
        Rcount = Sheet1.Range("K4").End(xlDown).Row - Range("K4").Row + 1
        Set Rng = Sheet1.Cells(4, "K").Resize(Rcount, Ccount)
'        Debug.Print Rng.Address ' check the address of the range created

        Rng.Copy Destination:=Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Offset(1)
    Next R
End Sub

现在，在省略了 Select 后，请注意 With 语句。它通过避免重复限定符进一步简化了代码。使用该技术，上述过程的最后一行将如下所示。每次使用时，重复的“Sheet2”都会被替换为前导句点。

With Sheet2
    Rng.Copy Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

我不确定您是否真的想使用 xlDown 来确定范围尺寸。我确实将其更改为 xlUp 以确定目标单元格，并将更改它以设置 For/Next 循环的结束，因为现在的代码将失败(因为 xlDown) 如果 A1 为空。在这种情况下，更好地了解 xlDown 和 xlUp 之间的区别。作为提示，xlDown 从起始单元格向下查找，直到找到空白，而 <​​em>xlUp 从起始单元格向上查找，找到非空白。因此，xlDown 将找到起始单元格后面的第一个空白单元格，并返回其上方的单元格，而 xlUp 将找到第一个非空白单元格(通常从最后一行开始)在表中)并将其退回。同样，对于 xlToLeft 和 xlToRight。