二次元配列内の要素で一致した行だけ別の配列にコピーしたい(抜き出ししたい)場合があります。
単純にFor~Loopで処理し、別の配列にコピーします。
条件に該当した行を抜き出しするサンプルコード
サンプルコードは完全一致での抜き出しです。
'■二次元配列内の要素を検索し、条件に一致した場所を探す
Public Function Call_ArraySearch2D(arr As Variant, sWord As String)
Dim i As Long, j As Long, k As Long
Dim tmp As Variant
ReDim tmp(UBound(arr, 1), UBound(arr, 2))
r = LBound(arr, 1)
c = LBound(arr, 2)
'■単純にFor~Loopで回して検索する
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, LBound(arr, 2)) = sWord Then
For j = LBound(arr, 2) To UBound(arr, 2)
tmp(r, c) = arr(i, j)
c = c + 1
Next j
r = r + 1
c = LBound(arr, 2)
End If
Next i
Call_ArraySearch2D = Call_RedimPreserveArray(tmp, r - 1)
End Function
実際の使い方
Public Sub sample()
Dim arr(3, 2) As Variant
Dim var As Variant
arr(1, 1) = 111
arr(1, 2) = "りんご"
arr(2, 1) = 222
arr(2, 2) = "みかん"
arr(3, 1) = 222
arr(3, 2) = "ぶどう"
'■222に完全一致するデータを配列varにコピーする
var = Call_ArraySearch2D(arr, "222")
Debug.Print var(1, 1) '222
Debug.Print var(1, 2) 'みかん
Debug.Print var(2, 1) '222
Debug.Print var(2, 2) 'ぶどう
End Sub
その他
- 完全一致ではなく部分一致の場合は Like = “*” & sWord “*” としてワイルドカードで取得をしましょう。
- 上記コードのみでは動作しません。こちらの二次元配列の一次元目の次元を変更するコードが必要です。



コメント