0

我是VBA的新手,很抱歉这个基本问题。我需要创建一个循环,在每次迭代中脚本:

  1. 将 O6:AA6 复制Wb1到同一工作簿的 O1:AA1 中
  2. 将列 B:E 复制到Wb2中,在命名为 中包含的值的工作表N6Wb1,例如“DGP1”。
  3. 重复上述两个步骤:将 O7:AA7 复制到 O1:AA1,将 B:E 复制到(由of 中Wb2包含的值给出的工作表名称,例如“DGP2”)。N7Wb1

我编写的代码虽然没有实现循环,也没有引用 中的值N6, N7,但至少执行了我需要的计算。在定义了两个工作簿之后,它包括:

Wb1.Activate
    Range("O6:AA6").copy
    Range("O1:AA1").PasteSpecial
    Columns("B:E").copy
Wb2.Activate
    Sheets("DGP1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

Wb1.Activate
    Range("O7:AA7").copy
    Range("O1:AA1").PasteSpecial
    Columns("B:E").copy
Wb2.Activate
    Sheets("DGP2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

实际上,我有更多行要复制粘贴,我需要通过N6, N7, ....

感谢您的任何建议,

斯特凡诺

4

2 回答 2

1

试试这个(您需要重命名工作簿名称和工作表名称):

Sub SO_19646599()
    Dim oWB1 As Workbook, oWB2 As Workbook
    Dim oWS1 As Worksheet, oWS2 As Worksheet
    Dim oRngRef As Range, oRng1 As Range, oRng2 As Range
    Dim sTmp As String, iOffset As Long, iErr As Long, sErr As String

    ' Source Workbook and Worksheet (assumed already open)
    Set oWB1 = Workbooks("Wb1")
    Set oWS1 = oWB1.Worksheets("Sheet1") ' Assuming Sheet1
    ' Target Workbook (assumed already open)
    Set oWB2 = Workbooks("Wb2")
    ' Reference range to start
    Set oRngRef = oWS1.Range("N6")
    ' Offset counter
    iOffset = 0
    ' Loop until oRngRef is an empty cell
    Do Until IsEmpty(oRngRef)
        ' Copy O6:AA6 to O1:AA1 in Wb1 (assuming Sheet1), with row offset
        Set oRng1 = oWS1.Range("O6:AA6").Offset(iOffset, 0)
        Set oRng2 = oWS1.Range("O1:AA1").Offset(iOffset, 0)
        oRng1.Copy Destination:=oRng2
        ' Get reference to Worksheet in Wb2 by the value contained in N6 of Wb1 (assumed Sheet1), with row offset
        sTmp = oRngRef.Value
        Set oWS2 = oWB2.Worksheets(sTmp)
        If oWS2 Is Nothing Then
            iErr = iErr + 1
            sErr = sErr & iErr & vbTab & "No such """ & sTmp & """ worksheet (" & oRngRef.Address & ") in " & oWB2.Name & vbCrLf
        Else
            ' copies the columns B:E from Wb1 (Sheet1) to Wb2 (Sheet name as N6)
            oWS1.Columns("B:E").Copy Destination:=oWS2.Columns("B:E")
        End If
        iOffset = iOffset + 1
        ' Update Reference range
        Set oRngRef = oWS1.Range("N6").Offset(iOffset, 0)
    Loop
    If iErr > 0 Then
        Debug.Print sErr
        MsgBox iErr & " errors occurred, please review Immediate window." & vbCrLf & vbCrLf & sErr
    End If
    ' Cleanup
    Set oWS2 = Nothing
    Set oWB2 = Nothing
    Set oWS1 = Nothing
    Set oWB1 = Nothing
End Sub
于 2013-10-29T05:59:24.793 回答
1

这是一个好的开始;这里有一些编写宏的技巧,它们可以帮助你开始,但也可以改进你的代码

  1. 范围- 大多数情况下,如果范围相同,将“目的地”范围设置为等于“原点”范围会更快、更有效。所以,而不是做

    Range("O6:AA6").copy
    Range("O1:AA1").PasteSpecial
    

    你可以做...

    Range("O1:AA1") = Range("O6:AA6").Value
    
  2. 选择- 您几乎不需要“选择”单元格和工作表(除非您希望在宏完成运行时选择该单元格/工作表)。最好直接参考工作表。再次,而不是

    Wb1.Activate
        Range("O6:AA6").copy
        Range("O1:AA1").PasteSpecial
        Columns("B:E").copy 
    Wb2.Activate
        Sheets("DGP1").Select
        Selection.PasteSpecial Paste:=xlPasteValues
    

    假设您的数据在表 1 上Wb1,您可以...

    Wb1.Sheets("Sheet1").Range("O1:AA1") = Wb1.Range("O6:AA6").Value
    Wb2.Sheets("DGP1").Columns("B:E") = Wb1.Sheets("Sheet1").Columns("B:E").Value
    
  3. For 循环- 要使用for循环,您可以设置一个变量并在给定递增变量的情况下构建您的范围字符串。例如,您可以将变量设置x为等于 6 并增加您想要的次数(假设 5 次到 10)

    for x = 6 to 10
        Wb1.Sheets("Sheet1").Range("O1:AA1") = _
              Wb1.Range("O" & x & ":AA" & x).Value
        Wb2.Sheets("DGP1").Columns("B:E") = _
              Wb1.Sheets("Sheet1").Columns("B:E").Value
    next x
    
  4. 范围/工作表引用- 如果单元格中的值是有效范围和/或工作表的名称,它们可以很容易地用于构建对该范围/工作表的引用。例如, Wb1.Sheets("Sheet1").Range("N6").Value等于“DPG1”,N6Sheet1的 中的值Wb1。将其与循环结合起来,您的最终代码将如下所示

        for x = 6 to 10
            Wb1.Sheets("Sheet1").Range("O1:AA1") = _
                  Wb1.Range("O" & x & ":AA" & x).Value
            Wb2.Sheets(Wb1.Sheets("Sheet1").Range("N" & x).Value).Columns("B:E") = _
                  Wb1.Sheets("Sheet1").Columns("B:E").Value
        next x
    

现在已经完成了,您应该知道每次都将不同的值 O6、O7 等粘贴到相同的位置 (O1)。我假设这不是您想要的,但您现在也拥有一些工具来更新该部分。

希望这可以帮助...

于 2013-10-29T00:27:10.870 回答