[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『 文字同士の比較』(ぽて)
初心者で申し訳ないのですが、
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.