Excel VBA質問箱 IV

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

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


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

15797 / 76734

←次へ　｜　前へ→


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

UO3 - 10/9/3(金) 12:07 -


	引用なし

	パスワード

▼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

0 hits

▼

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