|
▼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")
申し訳ありません”&”のかわりに”、”で動作しました。
ありがとうございました。
|
|