Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

15869 / 76807

←次へ　｜　前へ→


	【66413】Re:指定のセル範囲内の文字列

ai - 10/9/3(金) 12:49 -


	引用なし

	パスワード

▼UO3 さん：
>▼ai さん：
>
>こんにちは
>
>全て黄色がSample1 、　
>おまけに　Sample2 は　色を変えていきます。
>（でも６種類なので７種類目の文字列は最初の文字列と同じ色になりますが）
>
>Sub Sample1()
>Dim fAddr As String
>Dim myA As Range, myC As Range, fCell As Range
>Dim myDic As Object
>　Set myA = Range("C4:F11") '<== 指定範囲　例
>　Set myDic = CreateObject("Scripting.Dictionary")
>　myA.Interior.ColorIndex = xlNone
>　For Each myC In myA
>　　If Not IsEmpty(myC.Value) Then
>　　　If Not myDic.Exists(myC.Value) Then
>　　　　myDic(myC.Value) = True
>　　　　Set fCell = myA.Find(what:=myC.Value, LookIn:=xlValues, LookAt:=xlWhole)
>　　　　fAddr = fCell.Address
>　　　　Do
>　　　　　fCell.Interior.Color = vbYellow
>　　　　　Set fCell = myA.FindNext(fCell)
>　　　　Loop While fAddr <> fCell.Address
>　　　End If
>　　End If
>　Next
>　Set myA = Nothing
>　Set myC = Nothing
>　Set fCell = Nothing
>　Set myDic = Nothing
>End Sub
>
>Sub Sample2()
>Dim cnt As Long
>Dim colorTbl As Variant
>Dim fAddr As String
>Dim myA As Range, myC As Range, fCell As Range
>Dim myDic As Object
>　Set myA = Range("C4:F11") '<== 指定範囲　例
>　Set myDic = CreateObject("Scripting.Dictionary")
>　myA.Interior.ColorIndex = xlNone
>　colorTbl = Array(vbYellow, vbCyan, vbGreen, vbMagenta, vbBlue, vbRed)
>　For Each myC In myA
>　　If Not IsEmpty(myC.Value) Then
>　　　If Not myDic.Exists(myC.Value) Then
>　　　　myDic(myC.Value) = True
>　　　　Set fCell = myA.Find(what:=myC.Value, LookIn:=xlValues, LookAt:=xlWhole)
>　　　　fAddr = fCell.Address
>　　　　Do
>　　　　　fCell.Interior.Color = colorTbl(cnt Mod 6)
>　　　　　Set fCell = myA.FindNext(fCell)
>　　　　Loop While fAddr <> fCell.Address
>　　　　cnt = cnt + 1
>　　　End If
>　　End If
>　Next
>　Set myA = Nothing
>　Set myC = Nothing
>　Set fCell = Nothing
>　Set myDic = Nothing
>End Sub
ありがとうございます。
Sub Sample1()で動作確認をいたしました。
指定した範囲内で重複した文字列（2個）のセルが黄色になりました。
しかし指定した範囲内で重複していない文字列のセルも黄色になります。
よろしくお願いいたします。

0 hits

▼

【66409】指定のセル範囲内の文字列 ai 10/9/3(金) 10:48