VBA 配列 条件分岐で編集して別の配列に格納

質問

いつもありがとうございます。
VBAの配列を編集して、別の配列に格納出来なくて困ってます。ネットとかで確認しながら色々試してるのですが、うまくいきません。

8列目の値が2の時、対象行の内容を別の配列にコピーする方法です。

すみませんが教えて貰えないでしょうか？よろしくお願いします。

回答No.5

kkkkkm · ベストアンサー

回答No.4の訂正です。ボーとしてました。

flgはなくして
If flg = True Then
mR = mR + 1
End If
もいらなくて

ループを以下のようにできると思います。

For r = LBound(MyArray1, 1) To UBound(MyArray1, 1)
If MyArray1(r, 8) = "2" Then
ReDim Preserve MyArray2(1 To MaxColumn, 1 To mR)
For c = LBound(MyArray1, 2) To UBound(MyArray1, 2)
MyArray2(c, mR) = MyArray1(r, c)
Next
mR = mR + 1
End If
Next

お礼

色々考えてくれてありがとうございました。 次に考えるであろう行の空白部の処理も追加したコードも考えて頂き、感謝の言葉しかありません。本当にありがとうございました。

Powered by GRATICA

回答No.4

kkkkkm

回答No.2、回答No.3の補足です。

あと、ちょっと気になったですが

For c = LBound(MyArray1, 2) To UBound(MyArray1, 2)
If MyArray1(r, 8) = "2" Then
ReDim Preserve MyArray2(1 To MaxColumn, 1 To mR)
MyArray2(c, mR) = MyArray1(r, c)
flg = True
End If
Next

は、列方向のループをしながら各列で8列目が2かどうか調べていますので以下の方がいいのではないでしょうか。

8列目が2の時だけ列方向のループをして代入をします。

If MyArray1(r, 8) = "2" Then
For c = LBound(MyArray1, 2) To UBound(MyArray1, 2)
ReDim Preserve MyArray2(1 To MaxColumn, 1 To mR)
MyArray2(c, mR) = MyArray1(r, c)
flg = True
Next
End If

お礼

色々考えてくれてありがとうございました。

回答No.3

kkkkkm

回答No.2の補足です。

行を詰めないで元の行間隔のままでしたら

ループのあたりを以下のようにしてください。

ReDim MyArray2(1 To MaxRow, 1 To MaxColumn)
For r = LBound(MyArray1, 1) To UBound(MyArray1, 1)
For c = LBound(MyArray1, 2) To UBound(MyArray1, 2)
If MyArray1(r, 8) = "2" Then
MyArray2(r, c) = MyArray1(r, c)
End If
Next
Next

.Range("L3").Resize(UBound(MyArray2, 1), UBound(MyArray2, 2)).Value = MyArray2

お礼

色々考えてくれてありがとうございました。

回答No.2

kkkkkm

元のコードを維持してコードを一部追加しました。一セル分毎に取り出しているので一セル分毎に別の配列に代入します。
MyArray2() As Variantになってます。

Sub Test()
Dim r As Long, c As Long
Dim MyArray1 As Variant, MyArray2() As Variant
Dim MaxRow As Long
Dim MaxColumn As Long
Dim mR As Long: mR = 1
Dim flg As Boolean

With Worksheets("加工後")

MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
MaxColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
MyArray1 = .Range(.Cells(1, 1), .Cells(MaxRow, MaxColumn))
For r = LBound(MyArray1, 1) To UBound(MyArray1, 1)
flg = False
For c = LBound(MyArray1, 2) To UBound(MyArray1, 2)
If MyArray1(r, 8) = "2" Then
ReDim Preserve MyArray2(1 To MaxColumn, 1 To mR)
MyArray2(c, mR) = MyArray1(r, c)
flg = True
End If
Next
If flg = True Then
mR = mR + 1
End If
Next

'行と列が入れ替わっているのでTransposeで入れ替えてセルに代入します

.Range("L3").Resize(UBound(MyArray2, 2), UBound(MyArray2, 1)).Value = WorksheetFunction.Transpose(MyArray2)

End With
End Sub

お礼

色々考えてくれてありがとうございました。

回答No.1

rasuka555

やりたいこと配列そのもののコピーですか？
それとも、特定の配列のコピーですか？

前者であれば、Myarray2=Myarray1と余計なものは必要ありません。

後者であれば、Myarray2をReDim (Preserve)で拡張するなどしておいてから、Myarray2(r,c)=Myarray1(r,c)のように格納する必要があります。
ただし、ReDimで複数回拡張出来るのは基本的に2つ目の要素のみとなることに注意が必要です。

お礼

ヒントを教えてくれてありがとうございました。ヒントから色々試したのですが、配列の基礎が分かってなかったので、ヒントから答えに辿りつきませんでした。

次の人の内容のコードで、自分が思っていた以上の内容に仕上がってたので、悩みは解決しました。