【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社はそこに寄付なりをしないといけないのかと思いますが、どうなんでしょうね・・

この記事が気に入ったらサポートをしてみませんか?