[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2つの文字列を比較し、違う文字列を洗い出す』(ミドリ)
A列セルと、B列セルに文字列があります。
同じでない場合は、C列セルにfalseなどの返答のやり方がありますが、
マクロなど、A列セルと同じでないB列セルの文字列をC列セルに洗い出し出来たりする事は、出来るのでしょうか?
もちろん、文字列は、()や[]などもあります。
もし、わかる方がいらしたら、教えてください。
宜しくお願いします。
< 使用 Excel:Excel2019、使用 OS:Windows10 >
ただ、
「あいうえお」←→「かいうけお」=「かけ」
みたいに、比較する文字数と位置が同じであればそんなに大変ではないですが、
「いうえお」←→「かいうえか」=最初の「か」が余分、最後の「か」が不一致
みたいなことを想定されているのであれば、ものすごく難しくなると思います。
前者のようで良ければ、文字数をカウントしてからループ処理で、1文字目から順番に比較すればよいだけです。
トライしてみて、詰まったら改めて質問されてみてはどうでしょうか?
(もこな2 ) 2020/08/11(火) 04:16
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
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.