Excel VBA質問箱 IV

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

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


60439 / 76732 ←次へ | 前へ→

【20932】Re:重複データについて
回答  Hirofumi  - 04/12/26(日) 6:59 -

引用なし
パスワード
   重複の2つ目以降に色を替え、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

0 hits

【20931】重複データについて 初心者 04/12/26(日) 2:37 質問
【20932】Re:重複データについて Hirofumi 04/12/26(日) 6:59 回答
【20933】Re:重複データについて Hirofumi 04/12/26(日) 8:01 回答
【20945】Re:重複データについて 初心者 04/12/27(月) 14:49 お礼
【20934】Re:重複データについて [名前なし] 04/12/26(日) 12:08 回答
【20936】Re:重複データについて [名前なし] 04/12/26(日) 15:40 発言

60439 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free