[[20140725153928]]　『重複結果反映』（ももか）　ページの最後に飛ぶ

『重複結果反映』（ももか）

A列に多数の番号が入っているとします。
そのA列内で重複しているものはＢ列にフラグを立てたいです。

例えば
A列　　　　　B列
001　　　　　重複
002
003
004
001　　　　　重複

探したサイトで以下のＶＢＡを見つけて実行したのですが、時間がかかりすぎてしまいます。

Dim lastgyou As Integer

    Dim i        As Integer
    Dim j        As Integer
    Dim atai     As String

    'Sheet1を選択します
    Sheets("Sheet1").Select

    '最後の行を求めます
    ActiveSheet.Range("A1").End(xlDown).Select
    lastgyou = ActiveCell.Row

    '最後の行まで、B列を空にします。
    For i = 1 To lastgyou
        ActiveSheet.Cells(i, 2).Value = ""
    Next

    '1行目から最後の１つ前の行までチェックします
    For i = 1 To lastgyou - 1

        '今見ている i 行目の値を atai という変数に入れておきます。
        atai = ActiveSheet.Cells(i, 1).Value

        '今見ている行（ i ）の１つ下から、最後の行まで、チェックします
        For j = i + 1 To lastgyou

            'もし、ataiと　j　行目が、同じ値だった場合
            If atai = ActiveSheet.Cells(j, 1).Value Then

                'i行目と、j行目が重複していることになるので、
                '両方の行のB列に、「重複」という文字を代入します。
                ActiveSheet.Cells(i, 2).Value = "重複"
                ActiveSheet.Cells(j, 2).Value = "重複"
            End If
        Next
    Next

何か方法はありますでしょうか。
行数ですが、現在12,000ほどで、今後も増える予定です。

よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

もっといいマクロについては他の人の回答にお任せします。

さらにカラムの数、データの増加頻度ならびに増加割合などがわかりませんので、ご要望に沿えることが
できるかどうか自信がありませんが。

B1=IF(COUNTIF($B$1:B1,B1)>1,"重複","")

を入力し、データの最終行までコピーをすればそれらしいことはできます（ただし重複するデータのうち
最初に検知されるものについてはチェックできませんが）。

さてこちらの方法がいいのかどうか。
（ryopo^2） 2014/07/25(金) 16:01

数式に誤りが。

誤）B1=IF(COUNTIF($B$1:B1,B1)>1,"重複","")
正）B1=IF(COUNTIF($A$1:A1,A1)>1,"重複","")

失礼しました。

（ryopo^2） 2014/07/25(金) 16:07

=IF(COUNTIFS($A$1:INDEX($A:$A,LOOKUP(8^16,$A:$A,ROW($A:$A))),$A1)>2,"重複","")

でいけそうですね。

12000行もレコード数があるとなると、動きが相当重そうですが。。。

（ryopo^2） 2014/07/25(金) 16:36

とりあえず範囲を「A100」までとして

☆B1=IF(COUNTIF($A$1:$A$100,A1)>1,"重複","")　下へコピー

これでどうかな？。範囲はそちらで。

こんなかんじで？

（希望） 2014/07/25(金) 16:42

 面白そうなのでチャレンジ！
Sub 重複チェック()
    Dim s
    s = Timer
    Dim dic As Object
    Set dic = CreateObject("Scripting.dictionary")
    Dim tbl
    tbl = Application.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp)).Value)
    Dim Result
    ReDim Result(1 To UBound(tbl), 1 To 1)
    Dim i As Long
    For i = 1 To UBound(tbl)
        If Not dic.exists(tbl(i)) Then
            dic.Add tbl(i), i
        Else
            Result(i, 1) = "重複"
            Result(dic(tbl(i)), 1) = "重複"
        End If
    Next i
    Range("B1").Resize(UBound(Result, 1)).Value = Result
    MsgBox Timer - s
End Sub
（稲葉） 2014/07/25(金) 16:43

コメント返信：

[ 一覧(最新更新順) ]

[[20140725153928]] 『重複結果反映』（ももか） ページの最後に飛ぶ

[[20140725153928]]　『重複結果反映』（ももか）　ページの最後に飛ぶ