Question

我目前正在为excel编写VBA并获得1004：＆＃34;该命令不能用于多个选择＆＃34;。我的代码选择excel文件中的多个列（非连续）并将它们作为范围结合。然后它将范围和粘贴复制到另一个工作表上。我有一些Subs用于不同的报告。第一个报告运行得很好，但是当第二个报告尝试运行时，我得到了运行时错误。当我选择＆＃34; Debug＆＃34;它需要我到range.copy行。

我该怎么办？

以下代码：

In [32]: df.assign(k=0) \
           .merge(df.assign(k=0), on='k', suffixes=['1','2']) \
           .query("id1 == parent_id2")
Out[32]:
    id1 parent_id1  k id2 parent_id2
1     1             0   2          1
6     1             0   7          1
8     1             0   9          1
14    2          1  0   3          2
15    2          1  0   4          2
40    4          2  0   5          4
41    4          2  0   6          4
79    7          1  0   8          7
105   9          1  0  10          9
107   9          1  0  12          9
118  10          9  0  11         10

Answer 1

将工作表传递给子过程并使用它来限定所有父工作表引用。

Sub RunReports()

    Set wbMaster = ActiveWorkbook
    Set wsSheet = wbMaster.Sheets("Part x Part Matrix")
    With wsSheet
        if .AutoFilterMode then .AutoFilterMode = False
        SetRanges .cells(1).parent
    End With

    ...

End Sub

Sub SetRanges(ws as worksheet)
    with ws
        Set rngPartNumber = .Range("C:C")
        Set rngPartName = .Range("H:H")
        Set rngSupplier = .Range("Q:R")
        Set rngTPRStatus = .Range("X:Y")
        Set rngOffTool = .Range("Z1", .Range("AC1").End(xlDown))
        Set rngExceptionNotes = .Range("AH1", .Range("AH1").End(xlDown))
        Set rngMRD = .Range("AI1", .Range("AK1").End(xlDown))
    end with
End Sub

Answer 2

在the answer的Thomas Inzina上构建，以下代码将复制非连续数据，而不复制不属于联合的单元格。

Sub CopyAreas(ByVal Source As Range, _
              ByVal Target As Range, _
              Optional ByVal Inline As Boolean)
    Dim area As Range

    If Inline Then
        For Each area In Source.Areas
            area.Copy Destination:=Target
            Set Target = Target.Offset(area.Rows.Count)
        Next
    Else
        'Find the top-most and left-most cell in the Source
        Dim Topmost As Long, Leftmost As Long
        For Each area In Source.Areas
            If Topmost = 0 Then
                Topmost = area.Row
                Leftmost = area.Column
            Else
                If Topmost > area.Row Then Topmost = area.Row
                If Leftmost > area.Column Then Leftmost = area.Column
            End If
        Next
        'Copy each area to a location offset from the target, such that
        'the topmost cell will be in the row defined by Target and
        'the leftmost cell will be in the column defined by Target
        For Each area In Source.Areas
            area.Copy Destination:=Target.Range(area.Address).Offset(1 - Topmost, 1 - Leftmost)
        Next
    End If
End Sub

尝试复制UNION时出现运行时错误

2 个答案: