时间戳

首页 > 解决方案 > 有效地在工作表之间复制和过去的信息

excel - 有效地在工作表之间复制和过去的信息

问题描述

我在 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

标签： excelvbaautomation

解决方案

这是您的代码的重写，疣（如我上面的评论中所述）等等，这意味着它的功能没有改进。

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循环的结束，因为现在的代码如果 A1 为空白，它将失败（因为xlDown ）。在这种情况下，最好阅读xlDown和xlUp之间的区别。作为提示，xlDown从起始单元格向下查找直到找到空白，而xlUp从起始单元格向上查找以找到非空白。因此，xlDown将找到起始单元格之后的第一个空白单元格并返回其上方的单元格，而xlUp将找到第一个非空白单元格（通常来自工作表的最后一行）并将其返回。同样，对于xlToLeft和xlToRight。

推荐阅读