7

我正在尝试将多个非连续范围的值复制到一个数组中。我写了这样的代码：

summaryTempArray = .range("A2:D9,A11:D12,A14:D15").Value

但它只复制第一部分 (A2:D9)。然后，我尝试了以下操作并收到错误消息-“对象_全局的方法联合失败”-我使用联合的方式是否有任何错误？

summaryTempArray = Union(.range("A2:D9"), .range("A11:D12"), .range("A14:D15")).Value
4

4 回答 4

10

不知道你的 有什么问题union，但它会创建相同的范围，你在第一次尝试时就说过。

问题是，您现在有多个区域。你可以，据我所知，现在必须解决。

这是一个示例，它将解析所有区域的数组，而不单独添加每个单元格，而是将每个区域单独添加到摘要数组中：

Public Sub demo()
  Dim summaryTempArray() As Variant
  Dim i As Long

  With Tabelle1
    ReDim summaryTempArray(1 To .Range("A2:D9,A11:D12,A14:D15").Areas.Count)

    For i = 1 To .Range("A2:D9,A11:D12,A14:D15").Areas.Count
      summaryTempArray(i) = .Range("A2:D9,A11:D12,A14:D15").Areas(i)
    Next i
  End With

End Sub

希望这可以帮助。

于 2012-11-06T08:38:52.613 回答
2

如果将源范围放入数组很重要，我相信 Jook 的解决方案与您将获得的一样好。但是，我认为解决方案应该包括从不规则数组中提取值的说明。这并不难，但语法晦涩难懂。

我也不能让你的Union陈述失败。我认为上下文中有些东西会导致我无法复制的失败。

下面的代码显示这两个范围是相同的，并且只有第一个子范围被加载到您报告的数组中。它以一种可能令人满意的替代方法结束。

Option Explicit
Sub Test()

  Dim CellValue() As Variant
  Dim rng As Range

  With Worksheets("Sheet1")

    Set rng = .Range("A2:D9,A11:D12,A14:D15")
    Debug.Print rng.Address
    Set rng = Union(.Range("A2:D9"), .Range("A11:D12"), .Range("A14:D15"))
    Debug.Print rng.Address
    ' The above debug statements show the two ranges are the same.

    Debug.Print "Row count " & rng.Rows.Count
    Debug.Print "Col count " & rng.Columns.Count
    ' These debug statements show that only the first sub-range is included the
    ' range counts.

    CellValue = rng.Value

    Debug.Print "Rows " & LBound(CellValue, 1) & " to " & UBound(CellValue, 1)
    Debug.Print "Cols " & LBound(CellValue, 2) & " to " & UBound(CellValue, 2)
    ' As you reported only the first range is copied to the array.

    rng.Copy Destination:=Worksheets("Sheet2").Range("A1")
    ' This shows you can copy the selected sub-ranges.  If you can copy the
    ' required data straight to the desired destination, this might be a
    ' solution.

  End With

End Sub
于 2012-11-06T15:38:05.387 回答
0

我遇到了同样的问题并尝试了一些方法但没有成功，直到我遇到了这个问题：-

    dim i as integer
    Dim rng1 as range
    Dim str as string
    dim cels() as string
    Set rng1 = sheet1.Range("A2:D9,A11:D12,A14:D15")
    str = rng1.address(0,0)
    cels() = split(str, ",")     '<--- seems to work OK
    for i = 0 to 2
        Debug.Print cels(i)
    Next i

如果这是一种“不正确”的转换方法，我会很感兴趣。

于 2018-08-30T08:44:01.917 回答
0

可以从非并发单元格范围创建多维数组。我所做的是将上面的一些代码用于范围复制机制，我学到了两件事；使用该方法，您可以引用实际的单元格而不仅仅是数据，您还可以使用它移动和保持顺序。在我的个人项目中，我们必须使用一些 excel 文件来填写校准数据。它运行计算并生成校准记录报告供我们的文件稍后参考。这些库存文件很无聊！我想稍微修饰一下，并根据校准是否通过，为大多数文档空单元格着色。这些文件将各个检查步骤分开，因此我想要查看的范围并不总是相邻的。我想出的是使用下面的复制功能创建一个新工作表并将所有非并发范围粘贴到一组漂亮的新并发范围中，然后让我的数组查看新工作表以绘制我的表格。我让它运行我需要的查找，然后摆脱现在无用的工作表。

Public Sub ColorMeCrazy()


' First Declare your variables that you will need line notes will be added to all the ones for just the array problem
Dim chkarray As Variant

Dim i As Integer ' for the array lookup loop
Dim j As Integer ' also for the array lookup loop

Dim chk1 As Boolean
Dim chk2 As Boolean

Dim cpyrange As Range ' the non-concurrent range collector haha.
Dim cz As Range

chk2 = True

Set cz = Worksheets("AN_PRM-36").Range("A1:I1,C2:I2,I3:I35,A30:H32,D33:H35,C34:C35,A36:E36,A22:H23,D24:H24,A16:H16,A8:H9,D10:H10")

' the next item below sets the ranges i wish to use. see that they arent all just right next to eachother.
Set cpyrange = Worksheets("AN_PRM-36").Range("G7:H7,G15:H15,G21:H21,G28:H29")

' this is the new sheet i made to create the array with
Sheets.Add.Name = "AN_PRM-36tmp"

' the data gets coppied to the new sheet but now its all together
cpyrange.Copy Destination:=Worksheets("AN_PRM-36tmp").Range("A1")

' now i tell the array i want it to use the data on the new sheet
chkarray = Worksheets("AN_PRM-36tmp").Range("A1:B5")

'this was my look up for the nonsense that i wanted to do later
For i = LBound(chkarray, 1) To UBound(chkarray, 1)
        
    For j = LBound(chkarray, 2) To UBound(chkarray, 2)
        
        Debug.Print chkarray(i, j)
            If chkarray(i, j) = "Pass" Then
            chk1 = True
            Else
            chk2 = False
            End If
    Next
Next

If chk1 = True And chk2 = True Then
cz.Interior.ColorIndex = 4

Else
cz.Interior.ColorIndex = 3

End If

' this last bit will get rid of the new sheet and not ask you are you sure you want it gone.
Application.DisplayAlerts = False
Sheets("AN_PRM-36tmp").Delete
Application.DisplayAlerts = True


End Sub
于 2020-12-04T14:02:27.850 回答