[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2つのセルにある文章を比較して、同じ単語にハイライトを付ける』（生徒A）
質問失礼いたします。
（A1）にカレーライスに必要なものはジャガイモ、ニンジン
（B1）に肉じゃがに必要な野菜はジャガイモ、ニンジン玉ねぎ
と文章があったとします。
A1とB1の文章で共通している単語は「必要」「ジャガイモ」「ニンジン」なので、B1の文章の「必要」「ジャガイモ」「ニンジン」の文字にハイライトを付けるようにしたいと思っています。
これはさすがにマクロや関数で実現するのは難しいのかな、と思っているのですが、詳しい方に1度聞いてみたいと思い質問させていただきました。
ハイライトは、文字色を変えるでも問題ありません。
被っている単語が何かがわかるようにしたいです。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
本当にそうでしょうか。下記も共通しています。
「に」「な」「、」
「単語」として定義するためのルールがあるのでしょうか。
（aw） 2022/01/05(水) 17:02
Wordを使うと単語を分割してもらえるみたいです。 以下のページを参考しました。 http://upa-pc.blogspot.com/2015/04/word-vba-sentence-to-words.html
あとは総あたりで。
Sub sample()
wordlist = SplitWords("カレーライスに必要なものはジャガイモ、ニンジン")
Stop
For Each w In wordlist
Debug.Print w
Next
End Sub
Function SplitWords(s As String) As String() Dim wdApp As Word.Application ' Microsoft Word Object Libraryを参照設定するか型をObject型に Dim wdDoc As Word.Document Dim buf() As String
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
With wdDoc
.Words.Item(1) = s
ReDim buf(1 To .Words.Count)
For i = 1 To .Words.Count
buf(i) = .Words(i)
Next
End With
wdDoc.Close False
wdApp.Quit
SplitWords = buf
End Function
（´・ω・`） 2022/01/05(水) 17:26
いろいろと教えていただきありがとうございました！
（生徒A） 2022/01/05(水) 17:36
別案を提示します。
Sheet1のA , B列に比較したい文字列があるとします｡
A1: カレーライスに必要なものはジャガイモ、ニンジン
B1: 肉じゃがに必要な野菜はジャガイモ、ニンジン玉ねぎ
Sheet2に結果を表示します｡
一致箇所を赤のアンダーラインで示すようにしました｡
ここでは説明の便宜上カッコをつけてみましたが､上記例で言えば､
A1: カレーライス(に必要な)もの(はジャガイモ、ニンジン)
B1: 肉じゃが(に必要な)野菜(はジャガイモ、ニンジン)玉ねぎ
こんな感じの一致箇所が表示されます｡
参考にしてみてください｡
=== 参考コード === 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
If 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
If 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の２つの文字列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を構成する文字列を作成するところは､ ' 一般に使われているものから若干の修正を施しています｡ ' このほうが若干自然な回答が得られる気がします｡ # diff系のフリーソフトを探したほうが法被かもしれませんね。 （γ） 2022/01/05(水) 18:01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.