| |
皆様 ご指導ありがとうございます。
countAではなくcountIFでした。
両方ともちゃんと動作いたしました。
親切に対応して頂いて感激です。
▼Hirofumi さん：
>重複の２つ目以降に色を替え、Flagを立てれば善いのですね？
>
>Option Explicit
>
>Public Sub Repeated()
>
> '変更するパレット番号
> Const clngColor As Long = 3
> 'Flagを立てる列（Offset値）
> Const clngCol As Long = 11
>
> Dim i As Long
> Dim dicIndex As Object
> Dim vntData As Variant
> Dim rngList As Range
> Dim lngRows As Long
>
> Application.ScreenUpdating = False
>
> 'List先頭セルを設定
> Set rngList = ActiveSheet.Cells(2, "A")
> With rngList
> 'データ行数を取得
> lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
> 'データを配列に読み込み
> vntData = .Resize(lngRows).Value
> End With
>
> 'Dictionaryオブジェクトのインスタンスを作成
> Set dicIndex = CreateObject("Scripting.Dictionary")
>
> With dicIndex
> 'データの先頭から最終まで繰り返し
> For i = 1 To lngRows
> 'データが""で無い場合
> If vntData(i, 1) <> "" Then
> 'インデックスにデータが有る場合（重複の場合）
> If .Exists(vntData(i, 1)) Then
> '重複行位置に就いて
> With rngList.Offset(i - 1)
> '重複行位置をパレット番号の色にする
> .Interior.ColorIndex = clngColor
> 'L列に1を立てる
> .Offset(, clngCol).Value = 1
> End With
> Else
> 'インデクスにKeyと行位置を追加
> .Add vntData(i, 1), i
> End If
> End If
> Next i
> End With
>
> Set dicIndex = Nothing
> Set rngList = Nothing
>
> Application.ScreenUpdating = True
>
> Beep
> MsgBox "処理が完了しました"
>
>End Sub
|
|
初心者
- 04/12/27(月) 14:49 -
