Microsoft Access 掲示板

ふたつのテキストボックスにある文字列を比較したい

6 コメント
views

お世話になります。
テキストボックスA、テキストボックスBがあり、双方に入力された文字列を比較して、同じ文字列があればその文字列だけをテキストボックスAから削除したいのですが、そういったことがvbaで可能でしょうか?

テキストボックスA="あいうえおかきく"
テキストボックスB="かきくけこさしす"
のとき、"かきく"が重複していると判定し
テキストボックスB="けこさしす"に変換したいのです・・・
重複している文字列は必ず末尾というわけではなく、重複している文字数も都度変わります。

どなたかご存知であれば、教えてください。
よろしくお願いします。

TT
作成: 2025/01/24 (金) 13:56:50
通報 ...
1

テキストボックスA="あいうえおかきく"
テキストボックスB="かきくけこさしす"
のとき、"かきく" が重複していると判定し
テキストボックスB="けこさしす"に変換したい

シンプルに、テキストボックスBに入力された文字列を一文字ずつチェックしていけばいいでしょう
 

Function OnesideUnique(ByVal argA As Variant, ByVal argB As Variant) As Variant
    OnesideUnique = argB
    If (LenB(Nz(argA)) = 0 Or LenB(Nz(argB)) = 0) Then Exit Function
    Dim i      As Long
    Dim c      As Long
    Dim buff() As String
    
    For i = 1 To Len(argB)
        If (InStr(1, argA, Mid$(argB, i, 1), vbBinaryCompare) = 0) Then
            ReDim Preserve buff(c)
            buff(c) = Mid$(argB, i, 1)
            c = c + 1
        End If
    Next i
    If (UBound(buff) > -1) Then
        OnesideUnique = Join(buff, "")
    End If
End Function

 
テキストボックスA, Bともにフォーム上に設置したコントロールだと仮定すると
コマンドボタンのクリック時イベント等で結果を確認するといいでしょう

Private Sub コマンドボタン名_Click()
    Me.テキストボックスB.Value = _
        OnesideUnique(Me.テキストボックスA.Value, Me.テキストボックスB.Value)
End Sub
3
mayu 2025/01/25 (土) 09:19:49 修正 fc5d2@6c788 >> 1

慧眼のhatenaさんが仰せのように、もし 連続した複数文字列を対象 とするのでしたら
「連続」の定義、つまり最小で何文字連続している必要があるのか
を明確にする必要があるでしょう

テキストボックスA = "あいうえおかきく"
テキストボックスB = "[@あいうえお@おかき@きくうえお@いうえおかういあいうえおかきおかく]"

Bの文字列で「 連続3文字以上で構成された語句でAに対する最長マッチ 」を繰り返す
と定義した場合、

[@あいうえお@おかき@きくうえお@いうえおかういあいうえおかきおかく]

Bからは、背景色を付与した5箇所の語句を検知( グレーアウト部分は長さが不足 )し、
最終的に

テキストボックスB = "[@@@きく@ういおかく]"

をご希望の結果とするサンプルも載せておきます
 

Function OnesideUniqueX(ByVal argA As Variant _
                      , ByVal argB As Variant _
                      , Optional ByVal argMinimum As Long = 3 _
                      , Optional ByVal argPos As Long = 1) As Variant
    OnesideUniqueX = argB
    Dim i    As Long
    Dim j    As Long
    Dim buff As String

    If (LenB(Nz(argA)) = 0 Or LenB(Nz(argB)) = 0) Then Exit Function
    If (argMinimum < 1 Or argPos < 1) Then Exit Function

    For i = argPos To Len(argB) - argMinimum + 1
        If (InStr(1, argA, Mid$(argB, i, argMinimum), vbBinaryCompare) > 0) Then
            buff = Mid$(argB, i, argMinimum)

            For j = i + argMinimum To Len(argB)
                buff = buff & Mid$(argB, j, 1)
                If (InStr(1, argA, buff, vbBinaryCompare) = 0) Then
                    OnesideUniqueX = _
                        OnesideUniqueX(argA, Left$(argB, i - 1) & Mid$(argB, j), argMinimum, i)
                    Exit Function
                End If
            Next j
            OnesideUniqueX = Left$(argB, Len(argB) - Len(buff))
            Exit Function
        End If
    Next i
End Function

 

Private Sub コマンドボタン名_Click()
    '// 重複と見なす文字列の最小連続長は関数の第三引数で指定します
    Me.テキストボックスB.Value = _
        OnesideUniqueX(Me.テキストボックスA.Value, Me.テキストボックスB.Value, 3)
End Sub
2
hatena 2025/01/25 (土) 00:09:26 修正

例をみると連続した複数文字列を対象にするようにも思えますが、
一文字単位でも重複していれば削除するという仕様であれば、
mayuさんのコードでいいでしょう。
単純に下記でも同様の結果になります。

Function RemoveDuplicates(ByVal argA As Variant, ByVal argB As Variant) As Variant
    RemoveDuplicates = argB
    If argA <> "" And argB <> "" Then
        Dim i      As Long
        For i = 1 To Len(argA)
            RemoveDuplicates = Replace(RemoveDuplicates, Mid(argA, i, 1), "")
        Next i
    End If
End Function
4
hatena 2025/01/25 (土) 11:06:02 修正 >> 2

Bの文字列で「 連続3文字以上で構成された語句でAに対する最長マッチ 」を繰り返す
と定義した場合、

mayuさんの上記の定義を仕様とする場合は下記のコードでもよさそう。

Function RemoveDuplicatesX(ByVal argA As Variant _
                      , ByVal argB As Variant _
                      , Optional ByVal argMinimum As Long = 3) As Variant
    RemoveDuplicatesX = argB
    Dim lA As Long, lB As Long, l As Long
    lA = Len(Nz(argA))
    lB = Len(Nz(argB))
    If lA < argMinimum Or lB < argMinimum Then Exit Function
    If lB < lA Then l = lB Else l = lA
    
    Dim i As Long, j As Long
    For i = l To argMinimum Step -1
        For j = 1 To lA - i
            RemoveDuplicatesX = Replace(RemoveDuplicatesX, Mid(argA, j, i), "")
        Next
    Next
End Function

Private Sub コマンドボタン名_Click()
    '// 重複と見なす文字列の最小連続長は関数の第三引数で指定します(省略時は3)
    Me.テキストボックスB.Value = _
        RemoveDuplicatesX(Me.テキストボックスA.Value, Me.テキストボックスB.Value)
End Sub
5
mayu 2025/01/25 (土) 14:43:28 修正 fc5d2@6c788 >> 4

hatenaさんのコード、シンプルで素敵ですね
RemoveDuplicatesX 関数の内側ループ、終了の数値を 1 だけ足せば更に完璧かもです

-         For j = 1 To lA - i
+         For j = 1 To lA - i + 1
6

mayuさん、バグのご指摘ありがとうございます。
理由も含めてのていねいな解説、納得です。