【VBA】配列に含まれないデータを配列で返す(メールデータ)
最近ChatGPTでコードを探ることも多くなってきましたが、ChatGPTも微妙に間違ったコードを返してくるので困ったものです。
今回はあたかもちゃんとしたコードのように見えて、まったく間違ったコードが返ってきていたので、正しいコードをメモしておきます。
そうは言うものの汎用的なコードにするのが面倒でメインルーチンにダラダラと書いてしまうこがままありますが、ChatGPTのアシストでそんな面倒も乗り越えて関数を検討できますので、いい時代になったものです。
前提
このコードの前提は、matchArr()にメールアドレスそのものか、ドメインを後方一致のワイルドカード(*ドメイン名)で格納しており、宛先などをarr()にまとめて格納して、matchArr()以外のアドレスをすべて抽出して配列で返すというものです。
matchArr()には、安全な送付先などを想定しており、危険な宛先を抽出することを想定しています。
Function FilterEmails(arr() As String, matchArr() As Variant) As String()
'output
Dim result() As String
Dim counter As Long
counter = -1
Dim matchFound As Boolean
'ヌルデータ
Dim noInitArray() As String
'Counter
Dim i As Long, j As Long
'元データが合致していないかを確認
For i = LBound(arr) To UBound(arr)
'合致していないものとする
matchFound = False
'突合データとの一致の有無を確認
For j = LBound(matchArr) To UBound(matchArr)
'ドメイン突合
If InStr(matchArr(j), "*") > 0 Then
'元データのドメインが後方一致する場合フラグを立てる
If arr(i) Like Right(matchArr(j), Len(matchArr(j)) - InStr(matchArr(j), "*") + 1) Then
matchFound = True
Exit For
End If
'アドレス突合
Else
'アドレスが一致する場合
If arr(i) = matchArr(j) Then
matchFound = True
Exit For
End If
End If
Next j
'全てで一致しなければ
If Not matchFound Then
counter = counter + 1
If counter = 0 Then
ReDim result(0)
Else
ReDim Preserve result(counter)
End If
result(counter) = arr(i)
End If
Next i
If counter = -1 Then
FilterEmails = noInitArray()
Else
FilterEmails = result
End If
End Function
いかがでしたでしょうか。Likeの部分にまだ冗長なところが残っていますが、間違いがまざるものの、このような関数を簡単に書けるChatGPTはすべらしいです(しかし、格納する処理を各ルーチンを一つ奥のルーチンに間違って書くのは勘弁してほしいww)
ちなみにこのような回答を考えるためのベースとなる文書は別にあります。たとえば専門用語はWikiPediaを使っているようですが、学習に使うサイトの整備にコストがかかっているのであれば、OpenAI社はそこに寄付なりをしないといけないのかと思いますが、どうなんでしょうね・・
この記事が気に入ったらサポートをしてみませんか?