[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『 文字同士の比較』（ぽて）
初心者で申し訳ないのですが、
A列とB列の文字を比較して、間違っている文字同士を赤くしたい。
Sub test()
For j = 1 To 3
For n = 1 To 5
If Cells(n, 1) <> Cells(n, 2) Then
Cells(n, 1).Characters(Start:=o, Length:=1).Font.ColorIndex = 3
Cells(n, 2).Characters(Start:=o, Length:=1).Font.ColorIndex = 3
Else
Cells(n, 1).Font.ColorIndex = 1
Cells(n, 1).Font.Bold = False
End If
Next n
Next j
End Sub
とするとセル同士の違いはわかるのですが、文字で比較されないので困っています。
LenとMidを使いたいのですが、わかる方よろしくお願いします。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
Sub test()
Dim j As Long
Dim n As Long
For n = 1 To 5
If Cells(n, 1) <> Cells(n, 2) Then
For j = 1 To WorksheetFunction.Max(Len(Cells(n, 1)), Len(Cells(n, 2)))
On Error Resume Next
If Mid(Cells(n, 1), j, 1) <> Mid(Cells(n, 2), j, 1) Then
Cells(n, 1).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
Cells(n, 2).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
End If
On Error GoTo 0
Next j
Else
Cells(n, 1).Font.ColorIndex = 1
Cells(n, 1).Font.Bold = False
End If
Next n
End Sub
こういう事でしょうか？
（ウッシ） 2015/11/19(木) 13:49
すごく助かりました(^O^)
（ぽて） 2015/11/19(木) 14:08
For j = 1 To WorksheetFunction.Max(Len(Cells(n, 1)), Len(Cells(n, 2)))
の部分を他の表現で書くことは可能でしょうか？
（ぽて） 2015/11/19(木) 14:32
どういう意味ですか？
各セルの最大文字数を判定してます。
文字数が決まっている・・・・例えば6文字なら、
For j = 1 To 6
です。
（ウッシ） 2015/11/19(木) 14:41
WorksheetFunctionを使ったことがなかったので、
他の方法はないかと思ったのです。
すみません
（ぽて） 2015/11/19(木) 14:45
全てを知り尽くした人は、多分いないのでは？
IIF は使った事がありますか？
For j = 1 To IIf(Len(Cells(n, 1)) > Len(Cells(n, 2)), Len(Cells(n, 1)), Len(Cells(n, 2)))
他には、
Sub test1()
Dim j As Long
Dim n As Long
Dim s As Long
For n = 1 To 5
If Cells(n, 1) <> Cells(n, 2) Then
If Len(Cells(n, 1)) > Len(Cells(n, 2)) Then
s = Len(Cells(n, 1))
Else
s = Len(Cells(n, 2))
End If
For j = 1 To s
On Error Resume Next
If Mid(Cells(n, 1), j, 1) <> Mid(Cells(n, 2), j, 1) Then
Cells(n, 1).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
Cells(n, 2).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
End If
On Error GoTo 0
Next j
Else
Cells(n, 1).Font.ColorIndex = 1
Cells(n, 1).Font.Bold = False
End If
Next n
End Sub
とするとか。
（ウッシ） 2015/11/19(木) 14:50
IIFは使ったことあったので、こちらがわかりやすかったです！
ありがとうございました！！！(^O^)
（ぽて） 2015/11/19(木) 14:54
（通りすがり） 2015/11/19(木) 17:43
そう言えば、昔こんなものを作ってみたことがある。
Sheet1のA列とB列の文字列を比較して、
その差異を、Sheet2に表示するというものです。
まあ、こうしたものはdiff系のツールを使えばいいわけなんだけど。 何かの参考になれば幸いです。
---------------------------------- Option Explicit
Dim lcs() As Long Dim dic1 As Object Dim dic2 As Object Dim s1 As String Dim s2 As String Dim ws1 As Worksheet Dim ws2 As Worksheet
Sub main()
Dim k As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
'書き込み先のシートをクリアー
ws2.UsedRange.Clear
'A列とB列の差異を調べて結果をSheet2に表示する
For k = 1 To ws1.Cells(ws1.Cells.Rows.Count, 1).End(xlUp).Row
diff ws1.Cells(k, 1), ws1.Cells(k, 2)
Next
End Sub
Sub diff(r1 As Range, r2 As Range)
Dim ar1, ar2
Dim v
Dim pos As Long
Dim kk As Long
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
' 二つの文字列のLCSの長さを求める
get_lcs r1, r2
'それに対応する最長共通部分列を求める
get_lcs_string r1.Value, r2.Value
'結果をSheet2に書き込む
pos = Application.Max(ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row, _
ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row) _
+ 1
ws2.Cells(pos, 1) = s1
ws2.Cells(pos, 2) = s2
'最長共通部分列に該当しない文字列を表示
ar1 = get_partition(r1.Value, dic1)
kk = 0
For Each v In ar1
If v <> "" Then
kk = kk + 1
ws2.Cells(pos + kk, 1).Value = v
End If
Next
ar2 = get_partition(r2.Value, dic2)
kk = 0
For Each v In ar2
If v <> "" Then
kk = kk + 1
ws2.Cells(pos + kk, 2).Value = v
End If
Next
'最長共通部分列に該当しない文字列に、書式を設定（赤、アンダーライン）
setColor ws2.Cells(pos, 1), ws2.Cells(pos, 2)
End Sub
Function get_lcs(r1 As Range, r2 As Range)
Dim j As Long, k As Long
s1 = r1.Value
s2 = r2.Value
' 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 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 Function
Function get_partition(s As String, d As Object) As Variant
Dim key
For Each key In d.keys
Mid$(s, key, 1) = "_" ' 余り使用されない文字の意
Next
get_partition = Split(s, "_")
End Function
Function setColor(r1 As Range, r2 As Range)
Dim j As Long, k As Long
'背景色を水色
r1.Interior.ColorIndex = 34
r2.Interior.ColorIndex = 34
'マッチしない文字列の文字色を赤に
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
（γ） 2015/11/19(木) 23:19
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.