vba Excel 宏数组
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11456881/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Macro Arrays
提问by user1521458
Currently I have a macro that runs through a list and deletes duplicate values (in one column), but it's proving to be very inefficient. For every entry that it checks for duplicates, it has to run through the whole column; my file currently has 50,000 entries and that is no small task.
目前我有一个宏，它运行一个列表并删除重复值（在一列中），但它被证明是非常低效的。对于检查重复项的每个条目，它必须遍历整个列；我的文件目前有 50,000 个条目，这是一项不小的任务。
I think an easier way for the macro to work is for the macro to check if this value is in an array. If it is, then remove the row that the entry is in. If it isn't, add the value to the array.
我认为宏工作的一种更简单的方法是让宏检查这个值是否在数组中。如果是，则删除该条目所在的行。如果不是，则将该值添加到数组中。
Can someone provide some help with the basic outline of the macro? Thanks
有人可以提供有关宏基本轮廓的帮助吗？谢谢
回答by danielpiestrak
The Below code will loop through your source data and store it in an array, while simultaneously checking for duplicates. After the collection is complete it uses the array as a key to know which columns to delete.
下面的代码将遍历您的源数据并将其存储在一个数组中，同时检查重复项。收集完成后，它使用数组作为键来知道要删除哪些列。
Due to the high number of potentiol screen updates with the deletion be sure to turn screenupdating off. (included)
由于大量的potentiol 屏幕更新与删除一定要关闭screenupdating。（包括）
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
As requested, here is a similar way to do it, using Collections instead of an Array for key indexing: (RBarryYoung)
根据要求，这是一种类似的方法，使用集合而不是数组进行键索引：（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
Note that this method does not need to assume any datatype or integer limits for the values of the cells in the column.
请注意，此方法不需要为列中的单元格的值假定任何数据类型或整数限制。
(Mea Culpa: I had to hand-enter this in Notepad, because my Excel is busy running project tests right now. So there may be some spelling/syntax errors...)
（Mea Culpa：我不得不在记事本中手动输入，因为我的 Excel 现在正忙于运行项目测试。所以可能存在一些拼写/语法错误......）
回答by Siddharth Rout
This is a followup to my comment. Looping 50k records+ Looping the Arraywill be an over kill for such a simple operation.
这是我的评论的后续。循环 50k 记录+循环数组对于这样一个简单的操作来说将是一种过度杀戮。
Like I mentioned in my comment, copy the values from the array to a new sheet. Then insert a blank column next to the 50k entries and do a Vlookupor CountIf. Once done, do an Autofilter and then delete the duplicate entries in 1 go. Let's take an example and see how this will work.
就像我在评论中提到的那样，将数组中的值复制到新工作表中。然后在 50k 条目旁边插入一个空白列并执行 aVlookup或CountIf。完成后，执行自动过滤，然后一次性删除重复条目。让我们举一个例子，看看这将如何工作。
Let's say we have have an array with 1000 items? and in 1 sheet we have 50k data. The below code will be tested with 1000 items in Arrayand 50k DataSee Snapshot
假设我们有一个包含 1000 个项目的数组？在 1 张纸中，我们有 50k 数据。下面的代码将测试1000 items in Array并50k Data查看快照
Paste this code in a module (The code took less then 5 secs to finish)
将此代码粘贴到模块中（该代码用了不到 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
回答by Excel Developers
For Excel 2007 and later: Copy the array to a sheet and use the removeduplicates method:
对于 Excel 2007 及更高版本：将数组复制到工作表并使用 removeuplicates 方法：
set ws = worksheets.add
ws.[A1].resize(ubound(yourarray,1),ubound(yourarray,2)).value = yourarray
ws.usedrange.removeduplicates columns:=1, header:=no
This assumes the lower bound of your array is 1, that the column you want to de-duplicate is column 1 and that your list has no headers. You can then find the borders of the new range and read it back into your array (erase the current array first).
这假设数组的下限为 1，您要重复数据删除的列是第 1 列，并且您的列表没有标题。然后您可以找到新范围的边界并将其读回您的数组（首先擦除当前数组）。
回答by Nick
I would suggest filltering your column and then use a formula to find the duplicates and delete them. I don't have the actually code for you (you didn't give us any code)
我建议填充您的列，然后使用公式查找重复项并删除它们。我没有你的实际代码（你没有给我们任何代码）
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
I am sure you could put the filter in the code or just rember to fillter before you run the macro.
我相信您可以将过滤器放在代码中，或者在运行宏之前重新填充。
