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

Question

我在excel中有一个表格，如下所示:

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

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

T:* *   *   T:* *   *

  * *   *
  * *   *



T:* *   *

它由许多带有小计的小区域组成 - 用“T”表示的行。

E列是“价格”，“F”是数量，其余的要么是公式计算的，要么是空的。
所以我写了一个函数来从“E”收集数据，这正是我最初想要的。

但是现在我也想从“F”和“H”中获取数据，当“E”被验证时。

我的代码是:

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 的提示之后，我现在可以让它工作了。问题在于“newRange”的分配，而不是第二个，而是初始分配。正如加里的学生所暗示的那样，Union 以统一的方式收集细胞。

'error
Set newRange = cell

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

多年来放弃编程，现在我就像 10 年前的新手!

Answer 1

通过 Union() 构建一系列不相交的单元并将该范围从一个工作簿复制到另一个工作簿，这将是非常棒的，但 Excel 不支持

假设我们对列中的填充单元格感兴趣 E,F,G



但不是空的单元格。在这里，我们创建了双联范围，然后逐个单元格地复制:

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