Question

我在excel中有一个表单如下：

  E F G H ... N O P Q
  * *   *     * *   *
  * *   *     * *   *
              * *   *
              * *   *
              * *   *
T:* *   *   T:* *   *

  * *   *     * *   *
  * *   *     * *   *
  * *   *
  * *   *

T:* *   *   T:* *   *

  * *   *
  * *   *



T:* *   *

它包含许多带小计的小区域 - 用＆＃34; T＆＃34;表示的行。

E栏是＆＃34; Price＆＃34;和＆＃34; F＆＃34;是数量，其余的是公式计算，或空。所以我写了一个函数来收集来自＆＃34; E＆＃34;的数据，这最初是我想要的。

但现在我也想从＆＃34; F＆＃34;获取数据。和＆＃34; H＆＃34;同时，当＆＃34; E＆＃34;已经过验证。

我的代码是：

Private Function CollectCellsData(dataRange As Range) As Range
Dim cell As Range, newRange As Range

For Each cell In dataRange

    If Not cell.HasFormula = True And Not IsEmpty(cell.Value) Then
        If newRange Is Nothing Then
            Set newRange = cell
        Else
            Set newRange = Union(newRange, cell)
        End If
    End If
Next
Set CollectCellsData = newRange

End Function

Private Function CopyDataAndPaste(sSheet As Worksheet, sColumn As String, dSheet As Worksheet, dColumn As String)
Dim lastRow As Long
Dim dataRange As Range, newRange As Range

lastRow = sSheet.Cells(Rows.Count, sColumn).End(xlUp).Row
Set dataRange = sSheet.Range(sColumn & "3:" & sColumn & lastRow)
Set newRange = CollectCellsData(dataRange)

lastRow = dSheet.Cells(Rows.Count, dColumn).End(xlUp).Row
If Not newRange Is Nothing Then
    newRange.Copy
    dSheet.Range(dColumn & lastRow + 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If

End Function

我认为最简单的方法就是替代：

Set newRange = Union(newRange, cell)

成：

Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3))

但显然我错了。错误消息是

"Error 1004: Command cannot be used on multiple selection"

我认为我犯了一个概念上的错误。但是如果一个

Union(range1, range2, range3)

可以使用.Copy，为什么不在我的情况下？

编辑：

在将代码更改为

之后，我感觉不好

Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3))

行

发生错误

newRange.Copy

在 Chrismas007 强调Union（）方法应该工作之后，以及一些msgbox rng.address用于调试，我现在能够使它工作。问题在于＆＃34; newRange＆＃34;的分配，而不是第二个，而是初始分配。就像加里的学生所暗示的那样，联盟以统一的方式收集细胞。

'error
Set newRange = cell

'run
Set newRange = Union(cell, cell.Offset(0, 1), cell.Offset(0, 3))

多年来放弃编程，现在我和10年前的新手一样！

Answer 1

通过 Union（）构建一系列不相交的单元并将该范围从一个工作簿复制到另一个，但Excel不支持 <真的非常棒/ p>

假设我们对列 E，F，G

中的填充单元格感兴趣

enter image description here

但不是空单元格。在这里，我们创建dijoint范围，然后逐个单元格复制：

Sub CopyDisjoint()
    Dim rBig As Range, rToCopy As Range, ady As String
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim r As Range
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Set rBig = sh1.Range("E:H")
    Set rToCopy = Intersect(rBig, sh1.Cells.SpecialCells(xlCellTypeConstants))

    For Each r In rToCopy
        ady = r.Address
        r.Copy sh2.Range(ady)
    Next r
End Sub

Answer 2

如果复制具有多个选择的范围，则无法将其粘贴到具有多个选择的范围中。因此，您必须将粘贴范围设置为ONE CELL（这是范围左上角的单元格）以清除错误。

测试代码：

Sub TestIt()

    Dim Rng As Range

    Set Rng = Union(Range("A1"), Range("B1"), Range("D1"))

    Rng.Copy

    'This code will error:
        Rng.Offset(1, 0).PasteSpecial xlPasteValues
    'This code will run:
        Range("A2").PasteSpecial xlPasteValues

    MsgBox Rng.Address

End Sub

如何复制不连续范围的并集并将它们粘贴到另一个工作表中？

2 个答案: