Question

我尝试将粘贴值从一个工作簿复制到另一个工作簿。我想指定多个范围，这样我就可以避免为每个范围使用一个变量。我使用下面对我不起作用的简化代码：

Sub Gather()

Dim y As Workbook

'## Setting variables ##
 Dim Contractual_flow_mat_C66_r460_470_c120_130_140 As Variant


'## Open Workbooks ##

  Set y = Workbooks.Open("Y")

'## Store values ##

    Contractual_flow_mat_C66_r460_470_c120_130_140 = y.Sheets("66").Range("P56:R57", "P62:R68", "P72:R74")

'## Input the values ##

    ThisWorkbook.Sheets("Denominator").Range("D48:F49", "D51:F57", "D59:F61") = Contractual_flow_mat_C66_r460_470_c120_130_140

'## Other ##

y.Close

End Sub

我收到错误＆＃34;错误的参数数量或无效的属性分配＆＃34;在这一行：

Contractual_flow_mat_C66_r460_470_c120_130_140 = y.Sheets("66").Range("P56:R57", "P62:R68", "P72:R74")

Answer 1

除了保存源工作簿参考之外，您根本不需要使用任何变量：

Sub Gather()

  Dim y As Workbook
  Set y = Workbooks.Open("Y")

  ThisWorkbook.Sheets("Denominator").Range("D48:F49").Value2 = y.Sheets("66").Range("P56:R57").Value2
  ThisWorkbook.Sheets("Denominator").Range("D51:F57").Value2 = y.Sheets("66").Range("P62:R68").Value2
  ThisWorkbook.Sheets("Denominator").Range("D59:F61").Value2 = y.Sheets("66").Range("P72:R74").Value2

  y.Close

End Sub

现在，您可以使用变量，并且您应该使用工作表引用。 ThisWorkbook可以改变您，特别是在打开新工作簿时：

Sub Gather2()

  On Error GoTo ErrorHandler
  Dim destSheet As Worksheet
  Set destSheet = ThisWorkbook.Sheets("Denominator")

  Dim sourceBook As Workbook
  Set sourceBook = Workbooks.Open("Y")
  Dim sourceSheet As Worksheet
  Set sourceSheet = sourceBook.Sheets("66")

  destSheet.Range("D48:F49").Value2 = sourceSheet.Range("P56:R57").Value2
  destSheet.Range("D51:F57").Value2 = sourceSheet.Range("P62:R68").Value2
  destSheet.Range("D59:F61").Value2 = sourceSheet.Range("P72:R74").Value2

CleanExit:
  If Not sourceBook Is Nothing Then
    sourceBook.Close
  End If

  Exit Sub

ErrorHandler:
  MsgBox ("Failed to open workbook 'y'")
  Resume CleanExit

End Sub

我在那里为你添加了一些错误处理，以防万一＆＃39; Y＆＃39;不存在。

下一步是为实际范围地址添加一些变量，以便在需要复制更多范围或者范围发生变化（源或目标）时循环遍历它们。

Answer 2

通常，如果您声明范围如下所示，您的代码应该更进一步：

With Worksheets(1)
    Set someSource = .Range("P56:R57, P62:R68, P72:R74")
End With

With Worksheets(2)
    Set someTarget = .Range("D48:F49, D51:F57, D59:F61")
End With

因此，每个范围需要少"个。如果你想按自己的方式去做，那么棘手的部分是使用范围联盟的.Areas属性并循环遍历它。因此，试试这样：

Sub TestMe()

    Dim someSource      As Range
    Dim someTarget      As Range
    Dim rng1            As Range
    Dim rng2            As Range

    With Worksheets(1)
        Set someSource = Union(.Range("P56:R57"), .Range("P62:R68"), .Range("P62:R68"))
    End With

    With Worksheets(2)
        'Without a Union(), but the same:
        Set someTarget = .Range("D48:F49, D51:F57, D59:F61")
    End With

    Dim cnt1 As Long
    Dim cnt2 As Long

    For Each rng1 In someSource.Areas
        cnt1 = cnt1 + 1
        For Each rng2 In someTarget.Areas
            cnt2 = cnt2 + 1
            If cnt1 = cnt2 Then
                rng2.Value = rng1.Value
            End If
        Next rng2
        cnt2 = 0
    Next rng1

End Sub

我简化了任务，要求它将范围从第一个工作表复制到第二个工作表。一般来说它是完全相同的。

在嵌套循环中，我们的想法是我们有两个集合，我们应该确保：

工作表中的区域1（2）.Values =工作表中的区域1（1）.Values
工作表中的区域2（2）.Values =工作表中的区域2（1）.Values
工作表中的区域3（2）.Values =工作表中的区域3（1）.Values

修改如果您不喜欢嵌套循环的O（n ^ 2）复杂度，您可以使用区域的.Item(value)作为线性循环：

Dim cnt As Long For cnt = 1 To someSource.Areas.Count Debug.Print someSource.Areas.Item(cnt).Address Debug.Print someTarget.Areas.Item(cnt).Address someTarget.Areas.Item(cnt).Value = someSource.Areas.Item(cnt).Value Next cnt

复制粘贴多个范围VBA

2 个答案: