Question

我目前正在处理一个文件，该文件将某些单元格中的数据复制并粘贴到表中的另一张纸上。

我当前的VBA代码复制数据并搜索要粘贴到的单元格，但是如果目标单元格中当前有一个值，则将其循环以检查同一列中的后续行，直到找到一个空单元格为止。因此，如果表中当前有2000行数据，它将在登陆第2001行之前搜索所有2000个单元格，依此类推。

执行代码所花费的时间受表的大小影响。

有什么方法可以使该命令更快地执行？

下面是一个示例，它从两个单元格复制数据。

Sub Test()
Sheets("Sheet1").Select
Range("K10").Select
Selection.Copy
Sheets("Table").Select
Range("A2").Select
Do While Not (ActiveCell.Value = "")
ActiveCell.Offset(1, 0).Activate
Loop
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Select
Range("G15").Select
Selection.Copy
Sheets("Table").Select
Range("B2").Select
Do While Not (ActiveCell.Value = "")
ActiveCell.Offset(1, 0).Activate
Loop
End sub

Answer 1

尝试关注以下内容。

Sub CopyPaste()
Dim sht1, sht2 As Worksheet

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Table")

    sht1.Range("K10").Copy sht2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    sht1.Range("G15").Copy sht2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)

End Sub

Answer 2

尚不清楚您是否希望在工作表的使用范围内找到临时空白单元格，还是希望始终将新值放在使用范围的底部。这对两种情况都应该起作用。

Sub Test()

    Dim ws1 As Worksheet

    Set ws1 = Worksheets("sheet1")

    With Worksheets("table")
        'force a definition for a .UsedRange on the worksheet
        .Cells(.Rows.Count, "A") = Chr(32)
        .Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(10, "K").Value
        .Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(15, "G").Value
        'clear the artificial .UsedRange
        .Cells(.Rows.Count, "A").Clear
        'Debug.Print .UsedRange.Address(0, 0)
    End With

End Sub

请建议使代码执行效率更高

2 个答案: