[[20200810201839]] 『2つの文字列を比較し、違う文字列を洗い出す』(ミドリ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『2つの文字列を比較し、違う文字列を洗い出す』(ミドリ)

A列セルと、B列セルに文字列があります。
同じでない場合は、C列セルにfalseなどの返答のやり方がありますが、
マクロなど、A列セルと同じでないB列セルの文字列をC列セルに洗い出し出来たりする事は、出来るのでしょうか?
もちろん、文字列は、()や[]などもあります。
もし、わかる方がいらしたら、教えてください。
宜しくお願いします。

< 使用 Excel:Excel2019、使用 OS:Windows10 >


質問の意図を捕らえられていないかもしれませんが、
C1に
=IF(A1=B1,"",B1)
のように入力して下にコピーする方法ではいかがでしょうか?
(DS) 2020/08/10(月) 21:23

>マクロなど、A列セルと同じでないB列セルの文字列をC列セルに洗い出し出来たりする事は、出来るのでしょうか?
可能不可能でいえば、可能だと思います。

ただ、
「あいうえお」←→「かいうけお」=「かけ」
みたいに、比較する文字数と位置が同じであればそんなに大変ではないですが、
「いうえお」←→「かいうえか」=最初の「か」が余分、最後の「か」が不一致
みたいなことを想定されているのであれば、ものすごく難しくなると思います。

前者のようで良ければ、文字数をカウントしてからループ処理で、1文字目から順番に比較すればよいだけです。
トライしてみて、詰まったら改めて質問されてみてはどうでしょうか?

(もこな2 ) 2020/08/11(火) 04:16


Sub main()
'セルA1、B1を比較し、C1に書き出し
    Dim i As Long
    Range("C1").Value = Range("B1").Value
    For i = 1 To Len(Range("A1").Value)
        Range("C1").Value = Replace(Range("C1").Value, Mid(Range("A1").Value, i, 1), "")
    Next i
End Sub
(mm) 2020/08/11(火) 11:07

こんにちは。
以下のケースでは、どのような出力を想定しているのでしょうか。

     A列     B         C列
 1   abc   aabbcc
 2   abc   cba
 3   abc   abcc
(γ) 2020/08/11(火) 12:19

 確認質問に回答がありませんが、自由研究を載せます。

 Sheet1のA,B列に比較したい文字列があるとします。
 例えば、
 A1: いうえお	
 B1: かいうえか
 A2: 両者の不一致文字列を赤く着色するのではまずいですか?
 B2: 両者の一致文字列を赤着色するのではまずいでしょうか?
 といったものを用意します。

 Sheet2に結果を表示します。
 不一致箇所を赤のアンダーラインで示すようにしました。

 ここでは説明の便宜上カッコをつけてみましたが、上記例で言えば、
 A1: いうえ(お)	
 B1: (か)いうえ(か)
 A2: 両者の(不)一致文字列を赤(く)着色するのではまずいで(す)か?
 B2: 両者の一致文字列を赤着色するのではまずいで(しょう)か?
 こんな感じの不一致箇所が表示されます。
 参考にしてみてください。

 === 参考コード === 
 Option Explicit
 Dim ws1     As Worksheet
 Dim ws2     As Worksheet
 Dim dic1    As Object
 Dim dic2    As Object
 Dim s1      As String
 Dim s2      As String
 Dim lcs()   As Long

 Sub main()
     Dim k As Long

     Set ws1 = Worksheets("Sheet1")      '元データ
     Set ws2 = Worksheets("Sheet2")      '比較結果

     Set dic1 = CreateObject("Scripting.Dictionary")
     Set dic2 = CreateObject("Scripting.Dictionary")

     '書き込み先のシートをクリアー
     ws2.Columns("A:B").Clear
     ws2.Columns("A:B").NumberFormatLocal = "@"

     'A列とB列の差異を調べて結果をSheet2に表示する

     For k = 1 To ws1.Cells(ws1.Cells.Rows.Count, 1).End(xlUp).Row
         dic1.RemoveAll
         dic2.RemoveAll

         s1 = ws1.Cells(k, 1).Text: s2 = ws1.Cells(k, 2).Text

         ' 二つの文字列のLCS(Longest Common Subsequence:最長共通部分列)の長さを求める
         get_lcs s1, s2

         'それに対応する最長共通部分列を求める(dic1,dic2にLCSのそれぞれでのindexを保持)
         get_lcs_string s1, s2

         '当初文字列をSheet2に書く
         ws2.Cells(k, 1) = s1
         ws2.Cells(k, 2) = s2

         'dic1,dic2を元に、最長共通部分列に該当しない文字列に書式を設定(赤、アンダーライン)
         setColor ws2.Cells(k, 1), ws2.Cells(k, 2)
     Next
 End Sub

 Function get_lcs(s1 As String, s2 As String)
     Dim j As Long, k As Long
     'いわゆる動的計画法による。
     ' lcs(j,k) は s1の1からjまでの部分列と
     '             s2の1からkまでの部分列との
     '             LCSの長さを示す
     ReDim lcs(0 To Len(s1), 0 To Len(s2))
     For j = 1 To Len(s1)
         For k = 1 To Len(s2)
             If Mid(s1, j, 1) = Mid(s2, k, 1) Then
                 lcs(j, k) = lcs(j - 1, k - 1) + 1
             Else
                 lcs(j, k) = WorksheetFunction.Max(lcs(j, k - 1), lcs(j - 1, k))
             End If
         Next
     Next
 End Function

 Function get_lcs_string(s1 As String, s2 As String)
     get_lcs_string_sub Len(s1), Len(s2)
 End Function

 Function get_lcs_string_sub(j As Long, k As Long)
     If j = 0 Or k = 0 Then Exit Function
     If lcs(j, k) = lcs(j - 1, k - 1) Then
         Call get_lcs_string_sub(j - 1, k - 1)
     Else
         If Mid(s1, j, 1) = Mid(s2, k, 1) Then
             Call get_lcs_string_sub(j - 1, k - 1)
             dic1(j) = Empty     's1 の j番目の文字がLCSを構成
             dic2(k) = Empty     's2 の k番目の文字がLCSを構成
         Else
             If lcs(j - 1, k) >= lcs(j, k - 1) Then
                 Call get_lcs_string_sub(j - 1, k)
             Else
                 Call get_lcs_string_sub(j, k - 1)
             End If
         End If
     End If
 End Function

 Function setColor(r1 As Range, r2 As Range)
     Dim j As Long, k As Long

     'LCSに該当しない文字列の文字色を赤に
     For j = 1 To Len(r1.Value)
         If Not dic1.exists(j) Then
             With r1.Characters(Start:=j, Length:=1).Font
                 .Underline = xlUnderlineStyleSingle
                 .ColorIndex = 3
             End With
         End If
     Next

     For k = 1 To Len(r2.Value)
         If Not dic2.exists(k) Then
             With r2.Characters(Start:=k, Length:=1).Font
                 .Underline = xlUnderlineStyleSingle
                 .ColorIndex = 3
             End With
         End If
     Next
 End Function

 === 補足 ===
 アルゴリズムは、最長共通部分列(LCS)という
 古くからある有名な動的計画法の手法によっています。
 LCSとは、長さnとmの2つの文字列AとBが与えられたとき,
 両方の文字列に共通する部分文字列で最長のものを言います。

 最長共通部分列についてはWikipedia記事を参照ください。
https://ja.wikipedia.org/wiki/%E6%9C%80%E9%95%B7%E5%85%B1%E9%80%9A%E9%83%A8%E5%88%86%E5%88%97%E5%95%8F%E9%A1%8C
 このほかネット上を探すとたくさん解説記事があります。
 なお、LCSを構成する文字列を作成するところは、
 一般に使われているものから若干の修正を施しています。
 このほうが若干自然な回答が得られる気がします。

 (なお、別の質問掲示板で回答したものをリライトしました。)
(γ) 2020/08/12(水) 09:33

私にはこんな難しいVBAはできませんでしたので、
助かりました。ありがとうございました。
(ミドリ) 2020/08/16(日) 11:42

実際、こちらのVBAでエクセルシートに2つのボタンを設け、特定フォルダにあるテキストファイルを取り込み、2つのデータを比較したかったのですが(比較ボタンを設置したい)。

Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim FileN As String
Set Sh = ThisWorkbook.Sheets("Sheet1") ' <-- 読込みシート指定(※)
FileN = Application.GetOpenFilename("テキストファイル,*.txt")
If FileN <> "False" Then

    With Workbooks.Open(FileN, Format:=3, ReadOnly:=True)
        .Sheets(1).UsedRange.Copy Sh.Range("A1") '         <-- セル指定
        .Close
    End With
End If
Set Sh = Nothing
End Sub

Private Sub CommandButton2_Click()
Dim Sh As Worksheet
Dim FileN As String
Set Sh = ThisWorkbook.Sheets("Sheet1") ' <-- 読込みシート指定(※)
FileN = Application.GetOpenFilename("テキストファイル,*.txt")
If FileN <> "False" Then

    With Workbooks.Open(FileN, Format:=3, ReadOnly:=True)
        .Sheets(1).UsedRange.Copy Sh.Range("E1") '         <-- セル指定
        .Close
    End With
End If
Set Sh = Nothing
End Sub

(ミドリ) 2020/08/16(日) 11:51


コメント拝見。
いくら難しいものでもあなたのしたいことと違えば、
あなたには無価値です。本当に助かったのかな?
口先だけの言葉は不要です。

あなたの目指すことを、
いくつか例を挙げて説明してください。
まだ質問になっていないと思います。
どんな文字列を比較してどんな結果にしたいのですか?
あなたの頭の中までは覗けません。

勝手にコードを示したことを反省するところですが、
是非サンプルを示して、質問を完成してください。
(γ) 2020/08/16(日) 16:34


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.