|
▼ai さん:
>▼ai さん:
>>▼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
>>> 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
>>ありがとうございます。
>>正常動作しました。
>>セルの指定範囲ですが、下記のようにしたところ”実行時エラー”になりました。
>>記述ミスなのか不可能な範囲指定なのか御教授願います。
>> Set myA = Range("B4:B53" & "H4:H53")
>申し訳ありません”&”のかわりに”、”で動作しました。
>ありがとうございました。
もう一度御教授願いいたします。
Set myA = Range("B4:B53" , "H4:H53","B60:B109")
上記のように記述したところ、(指定範囲が3個)
”コンパイルエラー”
”引数の数が一致していません。又は不正なプロパティを指定しています。”
というダイヤログが表示されます。
よろしくお願いいたします。
|
|