2

現在、リスト全体を実行して (1 つの列の) 重複する値を削除するマクロがありますが、非常に非効率的であることがわかっています。重複をチェックするすべてのエントリについて、列全体を実行する必要があります。私のファイルには現在 50,000 のエントリがあり、それは簡単な作業ではありません。

マクロが機能するより簡単な方法は、マクロがこの値が配列内にあるかどうかを確認することだと思います。そうである場合は、エントリが含まれている行を削除します。そうでない場合は、配列に値を追加します。

マクロの基本的な概要について誰か助けてもらえますか? ありがとう

4

4 に答える 4

3

以下のコードは、ソース データをループして配列に格納し、同時に重複をチェックします。コレクションが完了すると、配列をキーとして使用して、削除する列を認識します。

削除に伴う潜在的な画面更新の数が多いため、必ず画面の更新をオフにしてください。(同梱)

Sub Example()
    Application.ScreenUpdating = false
    Dim i As Long
    Dim k As Long
    Dim StorageArray() As String
    Dim iLastRow As Long
    iLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

    ReDim StorageArray(1 To iLastRow, 0 To 1)

    'loop through column from row 1 to the last row
    For i = 1 To iLastRow
        'add each sheet value to the first column of the array
        StorageArray(i, 0) = ActiveSheet.Range("A" & i).Value
        '- keep the second column as 0 by default
        StorageArray(i, 1) = 0
        '- as each item is added, loop through previously added items to see if its a duplicate
        For k = 1 To i-1
            If StorageArray(k, 0) = StorageArray(i, 0) Then
                'if it is a duplicate set the second column of the srray to 1
                StorageArray(i, 1) = 1
                Exit For
            End If
        Next k
    Next i

    'loop through sheet backwords and delete rows that were maked for deletion
    For i = iLastRow To 1 Step -1
        If StorageArray(i, 1) = 1 Then
            ActiveSheet.Range("A" & i).EntireRow.Delete
        End If
    Next i

    Application.ScreenUpdating = true
End Sub

リクエストに応じて、キーのインデックス付けに配列の代わりにコレクションを使用する同様の方法を次に示します: (RBarryYoung)

Public Sub RemovecolumnDuplicates()
    Dim prev as Boolean
    prev = Application.ScreenUpdating
    Application.ScreenUpdating = false
    Dim i As Long, k As Long

    Dim v as Variant, sv as String
    Dim cl as Range, ws As Worksheet
    Set ws = ActiveWorksheet    'NOTE: This really should be a parameter ...

    Dim StorageArray As New Collection
    Dim iLastRow As Long
    iLastRow = ws.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

    'loop through column from row 1 to the last row
    i = 1
    For k = 1 To iLastRow
        'add each sheet value to the collection
        Set cl = ws.Cells(i, 1)
        v = cl.Value
        sv = Cstr(v)

        On Error Resume Next
            StorageArray.Add v, sv
        If Err.Number <> 0 Then
            'must be a duplicate, remove it
            cl.EntireRow.Delete
            'Note: our index doesn't change here, since all of the rows moved
        Else
            'not a duplicate, so go to the next row
            i = i + 1
        End If
    Next k

    Application.ScreenUpdating = prev
End Sub

このメソッドは、列内のセルの値に対してデータ型または整数の制限を想定する必要がないことに注意してください。

(Mea Culpa: 私の Excel は現在プロジェクトのテストを実行中なので、これをメモ帳に手で入力する必要がありました。そのため、スペル/構文エラーがある可能性があります...)

于 2012-07-12T17:20:53.477 に答える
1

これは私のコメントのフォローアップです。50kレコードのループ+配列のループは、このような単純な操作ではやり過ぎになります。

コメントで述べたように、配列から新しいシートに値をコピーします。次に、50kエントリの横に空白の列を挿入し、Vlookupまたはを実行しますCountIf。完了したら、オートフィルターを実行してから、重複するエントリを1回で削除します。例を見て、これがどのように機能するかを見てみましょう。

1000個のアイテムを含む配列があるとしましょう。1枚のシートに50kのデータがあります。以下のコードはでテストされ、スナップショット1000 items in Arrayを参照してください50k Data

ここに画像の説明を入力してください

このコードをモジュールに貼り付けます（コードが完了するまでに5秒もかかりませんでした）

ここに画像の説明を入力してください

Sub Sample()
    Dim ws As Worksheet, wstemp As Worksheet
    Dim LRow As Long
    Dim Ar(1 To 1000) As Long
    Dim startTime As String, EndTime As String

    startTime = Format(Now, "hh:mm:ss")

    Set ws = Sheets("Sheet1")
    Set wstemp = Sheets.Add

    '~~> Creating a dummy array
    For i = 1 To 1000
        Ar(i) = i
    Next i

    '~~> Copy it to the new sheet
    wstemp.Range("A1:A1000").Value = Application.Transpose(Ar)

    With ws
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row

        .Columns(2).Insert Shift:=xlToRight
        .Range("B1").Value = "For Deletion"
        .Range("B2:B" & LRow).FormulaR1C1 = "=COUNTIF(" & wstemp.Name & "!C[-1],RC[-1])"
        .Columns(2).Value = .Columns(2).Value

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter, offset(to exclude headers) and delete visible rows
        With .Range("B1:B" & LRow)
            .AutoFilter Field:=1, Criteria1:="<>0"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        '~~> Remove any filters
        .AutoFilterMode = False

        .Columns(2).Delete
    End With

    EndTime = Format(Now, "hh:mm:ss")

    MsgBox "The process started at " & startTime & " and finished at" & EndTime
End Sub
于 2012-07-12T18:01:12.583 に答える
1

Excel 2007 以降の場合: 配列をシートにコピーし、removeduplicates メソッドを使用します。

set ws = worksheets.add
ws.[A1].resize(ubound(yourarray,1),ubound(yourarray,2)).value = yourarray
ws.usedrange.removeduplicates columns:=1, header:=no

これは、配列の下限が 1 であり、重複除去する列が列 1 であり、リストにヘッダーがないことを前提としています。次に、新しい範囲の境界を見つけて、それを配列に読み戻すことができます (最初に現在の配列を消去します)。

于 2012-07-13T20:48:13.467 に答える
0

列を塗りつぶしてから、式を使用して重複を見つけて削除することをお勧めします。私はあなたのための実際のコードを持っていません（あなたは私たちにコードを提供しませんでした）

dim a as range
dim b as range
set a = Range ("A1")

Do while Not isEmpty(A)
Set b = a.offset(1,0)

If b = a then
b= ""
else a.offset (1,0)

Loop

フィルターをコードに入れるか、マクロを実行する前にフィルターを追加することができると確信しています。

于 2012-07-12T17:18:58.433 に答える