特定の文字列を除いた配列の作成マクロについて

質問

頭書の件、現在マクロで以下のようなことを行おうとしており悩んでおります。
皆様のお知恵を拝借いたしたく、お願いいたします。
エクセルのSheet1に以下のような形でデータが格納されております。
A行：文字列、B行：数字でそれぞれ60000個程度のデータ格納されております。

この中から、特定の文字列を含んだ列を全て削除したデータを配列に格納するマクロを作成したいと考えています。
「特定の文字列」は、例えば"山田", "佐藤", "田中"の３種類とします。
もし上述の文字列のいずれかを含んだデータが30000個あれば、削除後の30000個程度のデータを新しい配列に格納したいと思っています。
イメージ的には以下のような操作がしたいのですが、「If C(i, 1) <> List Then」では通らないので、この部分に該当するような操作をなにかしらの方法で表現できましたらご教授いただけると助かります。

Sub test()
Dim C As Variant
Dim D As Variant
Dim i As Long
Dim j As Long

Dim List As Variant
List = Array("山田", "佐藤", "田中")
C = Worksheets("Sheet1").Range("A1", "B6000")

For i = 1 To 60000
If C(i, 1) <> List Then
D(j,1)=C(i,1)
D(j,2)=C(i,2)
j=j+1
Else
End If
Next

End Sub

お手数をおかけいたしますが、宜しくお願いいたします。

回答No.2

chie65536（@chie65535） · ベストアンサー

以下のようにします。

-----ここから
'配列の要素を「１から使う」ので「Option Base 1」が必須
Option Base 1

Sub test()
Dim C As Variant

'Dを「動的配列」として定義
Dim D() As Variant
Dim i As Long
Dim j As Long
Dim k As Integer

'「どれか１つに一致してしまった」を示すフラグを定義
Dim f As Boolean

Dim List As Variant

List = Array("山田", "佐藤", "田中")

'6000行ではなく60000行の間違い
C = Worksheets("Sheet1").Range("A1:B60000")
j = 1

'Dを「２次元配列」として再定義
ReDim Preserve D(2, 1)

For i = 1 To 60000

'フラグを立てておく
f = True

'Listの要素数だけループする
For k = 1 To UBound(List)
'Listの１つと一致するか調べる
If C(i, 1) = List(k) Then
'どれかに一致したらフラグを消す
f = False
'それ以上Listを調べる必要はないのでForを抜ける
Exit For
End If
Next
'フラグが立ったままならどれにも一致しないので処理する
If f = True Then
'データが増えるので配列の「一番下の次元」を拡張する
'ReDim Preserve D(2, j)
'データをコピーする（行と列が逆になる事に注意）
D(1, j) = C(i, 1)
D(2, j) = C(i, 2)
j = j + 1
End If
Next
'Dの配列は「行と列を逆に作った」ので、行と列を入れ替える
D = WorksheetFunction.Transpose(D)
'Dの配列の要素数を確認するメッセージボックスを表示
MsgBox UBound(D, 1) & "," & UBound(D, 2)
'確認の為、C列、D列に配列の中身を代入してみる
Worksheets("Sheet1").Range("C1:D" & j - 1) = D

End Sub
-----ここまで

＊＊注意＊＊

動的配列の「D」は
D(2,1)→D(2,2)→D(2,3)→D(2,4)→D(2,5)→D(2,6)→……D(2,60000)
のように「一番下の次元」しか変更できません。

そのため「行と列を逆に作成」する必要があります。

お礼

ご連絡ありがとうございます。
動的配列では一番下の次元しか変更できないというのは知りませんでした。
詳細なご説明ありがとうございます。
非常に勉強になりました。

回答No.3

chie65536（@chie65535）

訂正。

変な場所に「コメントマーク」が入ってしまいました。

誤
'データが増えるので配列の「一番下の次元」を拡張する
'ReDim Preserve D(2, j)

正
'データが増えるので配列の「一番下の次元」を拡張する
ReDim Preserve D(2, j)

回答No.1

dogs_cats

List = Array("山田", "佐藤", "田中")は
List(0)に山田　List(1)に佐藤が格納されます。変数Cに対しListをループで比較する方法しかないと思うのですが。
Dは２次配列で要素数は6000,2と宣言しました。

一例です。do~loopを使用しています。
Sub test()
Dim C As Variant
Dim D(6000, 2) As Variant
Dim i, j, k As Long
Dim flag As Boolean

Dim List As Variant
List = Array("山田", "佐藤", "田中")
C = Worksheets("Sheet1").Range("A1", "B6000")

i = 1
k = 1

Do While i <= 6000

flag = True

'配列Listデータを０～2でループさせデータが一致した場合はD0を抜け
'flag = Falseとする（データを格納させないためのflag)
j = 0
Do While j <= 2

If C(i, 1) = List(j) Then flag = False: Exit Do
j = j + 1

Loop

If flag = True Then

D(k, 1) = C(i, 1)
D(k, 2) = C(i, 2)

k = k + 1
End If

i = i + 1

Loop

End Sub

お礼

早速のご連絡ありがとうございます。
ご連絡いただきました方法で、If文の部分をLike "*" & List(j) & "*"とすることで、目的のマクロにすることができました。早々にご対応いただきました誠にありがとうございました。