[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セル間の文字列を比較して、違う箇所に色をつけたいです』（さるちん）
掲題の通り、2つのセルの文字列を比較して、違っている箇所に色をつけたいです。
主に英文の新旧文章の比較が目的です。
こちらの過去ログで見つけた下記のVBAが理想通りなのですが、どうやらセル内に記号（:や( )など）があると、以降のセル内の文字列が全て赤くなってしまうようです。
記号も含めて "違っている箇所のみ色を変える" にはどこを修正すれば良いでしょうか？
自力で何とかできればと思いましたがお手上げで…。
よろしくお願いいたします。
Dim i As Long
Dim n As Integer, t As Integer, j As Integer, f As Integer, col_count As Integer Dim adrs As String Dim clr() Dim tbl As Range
adrs = ActiveCell.Address(0, 0)
Set tbl = Application.InputBox("範囲を指定して下さい", Type:=8)
col_count = tbl.Columns.Count
With tbl For i = 1 To .Rows.Count Range(adrs).Cells(i, 1).Font.ColorIndex = xlAutomatic If .Cells(i, 1) = .Cells(i, col_count) Then Range(adrs).Cells(i, 1) = .Cells(i, 1) Else f = 1 t = 1 For n = 1 To Len(.Cells(i, col_count)) If Mid(.Cells(i, 1), n, 1) = Mid(.Cells(i, col_count), t, 1) Then Range(adrs).Cells(i, 1) = Range(adrs).Cells(i, 1) & Mid(.Cells(i, col_count), t, 1) Else ReDim Preserve clr(f) clr(f) = t Range(adrs).Cells(i, 1) = Range(adrs).Cells(i, 1) & Mid(.Cells(i, col_count), t, 1) f = f + 1 If Len(.Cells(i, 1)) < Len(.Cells(i, col_count)) Then n = n - 1 End If End If t = t + 1 If t > Len(.Cells(i, col_count)) Then Exit For Next n For j = 1 To UBound(clr) Range(adrs).Cells(i, 1).Characters(Start:=clr(j), Length:=1).Font.ColorIndex = 3 Next j End If Next i End With End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
または、1セルずつ処理していますが、clrという変数は ReDim Preserve しかしていないので、長い文字列の後に短い文字列を処理しても大丈夫かな？、と心配になります。 が、人の書いたロジックをデバッグしてあげるほど暇ではないので、ご自分でステップ実行し、なんとか対応してください。（新しい行に移る度に、Preserve 付けないで ReDim すれば良いだけかも）
（???） 2018/06/04(月) 16:40
ReDim Preserve の辺りに光明が見えたので、もう少し勉強してみます。
ありがとうございました m(_ _)m
（さるちん） 2018/06/05(火) 16:43
コードを全部読み込んだわけではないですが、比較元と比較先を先頭から1文字ずつ取り出してチェックしている仕組みであるなら、???さんがコメントされているように、記号も含め何か文字等が挿入されてれば、ずれるから差異としてチェックされてるだけなのでは？
そのうえで、記号を無視するようにしたければ、改造ということになるんでしょうど、それは改造するご自身が元のコードを理解されていないとできないわけですから、まずはインデント付けなどをされてコードの理解をすることをおすすめしたんですが・・・・
＞ReDim Preserve の辺りに光明が見えた
何を言われているのかピンと来ているようですし、基礎的なことはわかっていて、インデントの付けなおしなんかしなくてもコードの理解はできているってことであれば、余計なコメント失礼しました。
（もこな２） 2018/06/06(水) 09:58
＞ReDim Preserve の辺りに光明が見えたので、もう少し勉強してみます。
データ毎に、f=1で初期化していますので、Preserveは問題ないです。
＞今回は諦めてこのまま使用します。
本当に使えるものなんですか？
同じ位置に、同じ文字があるかどうかをチェックするのが基本ロジックらしいです。 (文字列の長さで、若干アジャストがある）
従って、1文字でもズレたらそれ以降、全部変更扱いになっちゃいますよ。
更に今回は、英語の文章の比較ですよね？ 以下のサンプルでトライしたら、ほぼ全文が変更されたと判定されました。
The reservation was cancelled A reservation was canceled
人間の目で見ると The → A cancelled → canceled と２つだけが変わっただけですよね。
英文では、1文字単位の比較より、1ワード単位の順番比較じゃないと 全く使えないだろうなぁ、と思っていたんですけどねぇ。
まぁ、1ワード単位に作ったところで、語順が一つズレれば、 あとはやっぱり全部変更の判定になっちゃいますけどね。
現実問題として、どんだけ長い英文なんですか？
長ければ、それだけ判定が困難になるので、 現実のデータがどんなものなのか提示した方がいいです。
最低10ケースくらい提示して欲しいもんです。 それによっては、チャレンジする気になる者が出てくるかも知れません。
それと、この作業はどんな仕事で必要になるんですか？ それが分かると、こちらの興味も増すと言うものです。
（半平太） 2018/06/06(水) 10:57
>下記のVBAが理想通りなのですが 理想通りなら直す必要ないですよね？
ご自分で書いたコードではないと思いますが、
変数の登場数が多くて回りくどい書き方だなぁという印象です。
しかも、それでも、変数を使って欲しい箇所に変数が使ってなかったりで、
読みにくいです。
なので、新たに書き直してみました。
Sub test()
Dim rngTarget As Range
Dim rngResult As Range
Dim c As Range
Dim str1 As String
Dim str2 As String
Dim i As Long
Dim j As Long
On Error Resume Next
Set rngTarget = Application.InputBox("範囲を指定して下さい", Type:=8)
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub
With rngTarget
Set rngResult = .Columns(.Columns.Count + 1)
End With
For Each c In rngResult.Cells
str1 = Intersect(rngTarget.Columns(1), c.EntireRow).Value
str2 = c.Offset(, -1).Value
If str1 <> str2 Then
i = Len(str1)
j = Len(str2)
If i > j Then
str2 = str2 & Mid(str1, j + 1)
c.Value = str2
c.Characters(Start:=j + 1).Font.ColorIndex = 3
Else
c.Value = str2
End If
For i = 1 To j
If Mid(str1, i, 1) <> Mid(str2, i, 1) Then
c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
End If
Next
End If
Next
End Sub
仕様（＝さるちんさんがやりたいこと）が今一つ解ってないかもしれませんが、
この辺を叩き台にして微調整出来ないでしょうか？
あぁ、半平太さんのコメントをみると、
＞セル内に記号（:や( )など）があると、以降のセル内の文字列が全て赤くなってしまう
この原因は、余分な文字が付いた、とか、字が消えているというのが原因かもですね。
そもそも文章のチェックならワードVBAを使った方が便利かもですねー
（まっつわん） 2018/06/06(水) 12:07
＞そもそも文章のチェックならワードVBAを使った方が便利かもですねー
「ワード VBA 文章 変更箇所 チェック」で検索したら、いろいろ出てきました。
例： 【2つの文書を比較する】 http://www.moug.net/tech/woopr/0041006.html
それなんか、元々ワードについている機能なんですねぇ。
（半平太） 2018/06/06(水) 12:55
ワードでの比較も提案したのですが、元々Excelで作っているシナリオを、出来ればそのままいじらずにチェック作業をしたいとの要望で…。
リーダーからワードは即座に却下されてしまいました(泣)
半平太サマ＞
どんな仕事で必要か、ですが。
動画を作る仕事をしておりまして、そのシナリオのチェック用です。
動画作成にはAdobe社のPremiereを使用していて、基本的に動画作成する際にはExcelのシナリオをコピーして貼り付けているのですが、
ちょっとした修正が入った場合等はPremiere上で手打ちで修正を行ってしまう事もあります。
この"ちょっとだから手打ちで修正"等々、Premiere上での修正でミスが生まれる事があり…。
先期 お客様から叱られるようなポカをしたメンバーがいたようで、このチェック作業が必須となりました。
シナリオはExcelで作成していまして、
A列にシーンNo.、B列に画面イメージ、C列に日本語の原稿、D列に原稿を元に作成した日本語シナリオ、
E列にD列を翻訳した英語、F列にPremiere上でテキスト打ちしている英語 が記載されています。
(F列はPremiereからExcelに逆貼り付けした物となっています)
物によって列数も変動しますが、基本的な並びは↑です。
シナリオ(D列)とPremiereの内容(F列)が完全一致してないとダメ！という事です。
英語は単語が数個並んでいるだけだったり、ナレーションで長々しゃべっている場合ですと1個のセル内で700文字、ということもあり、内容により単語量は様々です。
教育動画のような、10分間延々しゃべっているような物もあったりするので、それのチェックを考えた時に眩暈がしてしまいまして、何とか作業の軽減を…と思った次第です。
今はG列にEXACT関数でTRUEかFALSEかの判定をさせて、H列に質問させて頂いたVBAで違いのある箇所を示して貰って、真っ赤になってしまったところは地道に目視…という作業をしています。
F列を地道に修正していって、EXACT関数で全てがTRUEになったらチェック終了としています。
長々と下手な文章ですみません…(--;)
（さるちん） 2018/06/06(水) 16:13
英語は単語毎にスペースで区切られているので、スペース文字を指定してSplitすれば、単語毎に分かれて配列化できます。比較元と比較先を、1単語1セルにしてから、セル単位で単純に条件付き書式でも使って比較、色づけしてはいかがでしょう？（単語毎に1セルにするのは、「データ」－「区切り位置」機能でもできますので、まずはこれを試すと良いでしょう）
だいたいは、同じなんですよね？ 違っていたら区別が付けば良いのであり、1文字違いで単語全部塗っても、十分判ると思います。 この方が簡単で処理も速いと思いますが、いかがでしょう？
（???） 2018/06/07(木) 10:15
＞長々と下手な文章ですみません
いやー、こういう話を聞かせて貰えるとワクワクします。
単に「AAAAとABBAの差分を洗い出したい」なんて無味乾燥な質問は面白みに欠けますからねぇ。
ネット検索すると、チャンとロジックが整理されているんですねぇ。 (エディットグラフとか言う分析手法です)
VABの実装は、ここにありました。 ↓ Excel VBAで文字列の差分 http://ziomatrix18.blog68.fc2.com/blog-entry-407.html
下の二つを比較テストしてみると(ModuleTestRun) 「The reservation was cancelled」 「A reservation was canceled」
上の文字列は、「The」とcancelledの後ろの「l」が赤くなり、 下の文字列は、 「A」だけ赤くなりました。
使えそう。
ただ、元データセル(A1、A2)に直接色付けしちゃうので、 別セルに元データをコピーして、そっちを処理対象にするといいかもです。
（半平太） 2018/06/07(木) 23:41
こちら参考にさせて頂いて、頑張っていじってみます。
ありがとうございました！！
（さるちん） 2018/06/12(火) 09:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.