Question

我已经在这个VBA代码上工作了一段时间，因为我是一个完整的菜鸟，我觉得我没有得到任何地方。我一直在研究，但似乎无法将答案与我的情景相结合。

基本上我要做的是从一个工作表中逐行获取数据并将其外推到另一个工作表。我相信这将涉及循环，我对VBA这么新，我不知道该怎么做。

这是我正在尝试的逻辑：对于工作表1上的每一行，我想对工作表2执行3个不同的复制和粘贴活动，然后它将循环到sheet1上的下一行并执行3个活动，依此类推。这将继续向下，直到sheet1中的列A为空。 Sheet1数据从A3开始，sheet2粘贴区域从A2开始。

第一个活动是复制单元格F3，D3，A3和H3（按此顺序，因此F3将为A2，D3将为B2等）从表格1到表格2到A2，B2，C2等。无法使用目标函数，因为我只需要值而不需要其他格式 - 我遇到的众多问题之一。

下一个活动是将单元格F3，D3，A3和I3从工作表1复制到上一个复制下面粘贴的工作表2，然后粘贴再没有格式的值。另外需要注意的是，其中一些可能是空白的（A列除外），但我仍然需要那里至少包含A列数据的行 - 这与所有这些活动有关。

第三项活动是将sheet1的F3，D3和A3复制并粘贴一定次数，引用K3的编号 - 每次复制和粘贴都将在下一个可用的空白单元格中。因此，如果K3中的数字看起来像在sheet2中创建了3行 - 在sheet2上共计5行，因为activity1和2各自创建了自己的行。

在第1页的第3行完成这三项活动后，它将移至第4行并执行前三项活动并粘贴到sheet2。再次，它将粘贴没有格式，并在第2页的下一个空白行中。同样，一旦A列中的单元格为空，此循环将停止。

以下是我的不完整代码。我甚至认为它不会有所帮助，最好不要看它。我刚刚开始感到沮丧，因为我甚至不能做一个简单的复制和粘贴，但在循环中单独循环。我还没有开始我的第三项活动。我非常感谢！

Sub copyTest3()

Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range

Set proj = Range("A3", Range("A3").End(xlDown))
Set release = Range("D3", Range("D3").End(xlDown))
Set pm = Range("F3", Range("F3").End(xlDown))
Set lead = Range("H3", Range("H3").End(xlDown))
Set coord = Range("I3", Range("I3").End(xlDown))

Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)


For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))
    leadCopy.Copy
    Sheets("Sheet2").Activate
    Range("A2").Select
    ActiveSheet.PasteSpecial xlPasteValues

    Application.CutCopyMode = False

    Sheets("Sheet1").Activate
    coordCopy.Copy
    Sheets("Sheet2").Activate
    Range("A2").Select
    ActiveSheet.PasteSpecial xlPasteValues

Next i

End Sub

Answer 1

我通常在Excel中的工作表之间复制数据的方法是创建源范围和目标范围对象，每个范围仅指一行。当我想继续下一行时，我使用Offset将范围偏移量返回到下一行。

由于范围仅引用一行，因此可以使用整数对其进行索引以获取行中的单元格。例如。如果cursor引用第3行中的A到D列，则cursor(3)将为您提供单元格C3。

Dim src_cursor As Range
Dim dest_cursor As Range

Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")

'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
    dest_cursor(1) = src_cursor(6) '' copy F -> A
    dest_cursor(2) = src_cursor(4) '' copy D -> B
    '' and so on

    '' move cursors to next row
    Set src_cursor = src_cursor.Offset(1, 0)
    Set dest_cursor = dest_cursor.Offset(1, 0)
Loop

此外，这可能会有点偏离主题，但最好使用Enum来命名列号，而不是像我在这里那样硬编码。

Answer 2

有很多方法可以做到这一点，有些方法比其他方法更有效。我的解决方案可能不是最有效的，但希望您能够轻松理解，以便您可以学习。

很难理解你在第三项活动中尝试做什么，所以我无法为这一步提供解决方案。使用我的代码作为第三步的模板，如果遇到问题，请随时发表评论。

请注意，我在此代码中未使用.Activate，.Select或.Copy。 .Activate和.Select是效率很高的杀手，它们使您的代码更容易“破解”，因此请尽可能避免使用它们。使用值或公式时，.Copy不是必需的，也会降低代码的速度。

<强>未测试

Sub testLoopPaste()

Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")

'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2

'This is the beginning of the loop
For i = 3 To LastRow
    'First activity
    sht2.Range("A" & ii) = sht1.Range("F" & i).Value
    sht2.Range("B" & ii) = sht1.Range("D" & i).Value
    sht2.Range("C" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D" & ii) = sht1.Range("H" & i).Value
    ii = ii + 1

    'Second activity
    sht2.Range("A" & ii) = sht1.Range("F" & i).Value
    sht2.Range("B" & ii) = sht1.Range("D" & i).Value
    sht2.Range("C" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D" & ii) = sht1.Range("I" & i).Value
    ii = ii + 1

    'Third activity
    For i3 = 1 To sht1.Range("K" & I)  
        sht2.Range("A" & ii) = sht1.Range("F" & i).Value  
        sht2.Range("B" & ii) = sht1.Range("D" & i).Value  
        sht2.Range("C" & ii) = sht1.Range("A" & i).Value  
        ii = ii + 1  
    Next i3

Next i

End Sub

循环中的Excel VBA复制和粘贴循环

2 个答案: