|
▼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")
|
|