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声明を失敗させることはできません。私が複製できない失敗を引き起こすコンテキストについて何かがあると思います。

以下のコードは、2 つの範囲が同じであり、報告したように最初のサブ範囲のみが配列に読み込まれることを示しています。満足できる別のアプローチで終了します。

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

並行していないセル範囲から多次元配列を作成することができます。私がしたことは、上記のコードの一部を範囲コピーのメカニズムに使用することで、2 つのことを学びました。その方法を使用すると、データだけでなく実際のセルを参照でき、移動して順序を維持することもできます。私の個人的なプロジェクトでは、いくつかの Excel ファイルを使用してキャリブレーション データを入力する必要があります。計算を実行し、ファイルが後で参照できるように校正記録のレポートを作成します。これらのストック ファイルは退屈です。私はそれを少し整えて、キャリブレーションが成功したかどうかに応じて、ほとんどのドキュメントの空のセルに色を付けたいと思いました. ファイルは個々のチェック手順を分離しているため、調べたい範囲が常に隣接しているとは限りません。私が思いついたのは、以下のコピー機能を使用して新しいシートを作成し、すべての非並行範囲を並行範囲の 1 つの素敵な新しいセットに貼り付けてから、配列に新しいシートを見てテーブルを描画させることです。必要なルックアップを実行してから、不要になったシートを取り除きます。

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 に答える