Excel VBA質問箱 IV

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

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


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

15793 / 76734

←次へ　｜　前へ→


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

UO3 - 10/9/3(金) 13:03 -


	引用なし

	パスワード

▼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
　　　　If WorksheetFunction.CountIf(myA, myC.Value) > 1 Then
　　　　　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
　　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
　　　　If WorksheetFunction.CountIf(myA, myC.Value) > 1 Then
　　　　　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
　　End If
　Next
　Set myA = Nothing
　Set myC = Nothing
　Set fCell = Nothing
　Set myDic = Nothing
End Sub

2 hits

▼

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