二次元配列内の要素で一致した行だけ別の配列にコピーしたい(抜き出ししたい)場合があります。
単純に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 “*” としてワイルドカードで取得をしましょう。
- 上記コードのみでは動作しません。こちらの二次元配列の一次元目の次元を変更するコードが必要です。
コメント