Excel宏陣列

Question

目前我有一個宏，它貫穿列表並刪除重複值（在一列中），但它證明效率很低。對於每個檢查重複項的條目，它必須遍歷整個列;我的文件目前有50,000個條目，這不是一個小任務。

我認爲宏工作的一個更簡單的方法是讓宏檢查這個值是否在數組中。如果是，則刪除條目所在的行。如果不是，則將該值添加到數組中。

有人可以提供一些關於宏的基本輪廓的幫助嗎？謝謝

Answer 1

下面的代碼將遍歷源數據並將其存儲在一個數組中，同時檢查重複項。收集完成後，它使用該數組作爲關鍵字來知道要刪除哪些列。

由於刪除的電位器屏幕更新次數很多，因此請務必關閉屏幕更新。 （含）

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 

注意，此方法不不需要爲該列中的單元格的值假定任何數據類型或整數限制。

（過失：我不得不在記事本中手工輸入這一點，因爲我的Excel是忙碌的運行項目的測試，現在所以可能有一些拼寫/語法錯誤...。）

Answer 2

我會建議填充你的列，然後使用公式來找到重複項並刪除它們。我沒有爲你的實際代碼（你沒有給我們任何代碼）

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 

我相信你可以把過濾器中的代碼，或只是你的rember運行宏之前fillter。

Answer 3

這是一個後續對我的評論。 循環50k記錄 + 循環陣列將是一個這樣一個簡單的操作過度殺死。

就像我在我的評論中提到的，將數組中的值複製到新工作表中。然後在50k條目旁邊插入空白列並執行Vlookup或CountIf。完成後，執行一次自動篩選，然後刪除重複條目。我們來舉個例子，看看它是如何工作的。

假設我們有一個包含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 

Answer 4

對於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，並且列表中沒有標題。然後可以找到新範圍的邊界並將其讀回到陣列中（首先擦除當前陣列）。