如何编写Excel-VBA代码来更新Excel程序中导出的数据的Excel工作表？

业余编码器在这里，我想写一个Excel-VBA代码，可以自动更新来自数据转储的新信息的行（原始数据来自以前的转储，只是想保持Excel表最新与数据转储，并保持用户input数据与数据转储数据alignment）。 该代码应该比较每行的前4列中的值在整个工作表上的同一列上的重复数据，如果它发现重复行具有相同的数据，它将用新的数据replace原来的行只是一个例子我制造。 因此，在这个例子中，代码将replace第1行：列EFG与第8行的列EFG，因为它们全部被更改，但保留所有用户input数据与新的数据。 第5行的列FG也一样，用第11行的FG列代替。 等等。 然后根据列AD中的重复数据删除所有重复的行。 我在Excel-VBA中编写了一些非常基本的代码，但是这个代码远远超出了我的能力，所以我甚至不知道从哪里开始。 任何build议或简单的起点将有所帮助！

我最近运行了一些在Excel VBA中查找重复的testing。 这是StackOverflow的一个常见问题，使用各种方法，答案从笨重到精致。

我恐怕OP没有提供足够的信息来回答他/她的具体问题，但显然他/她需要编写一个例程来pipe理重复。 所以我希望下面的代码会有一些帮助。

testing涉及获取500,000个项目的数据集，将唯一值写入新工作表并将这些值存储在array或Collection 。 我logging了使用5种不同方法处理任务的时间： Range.AdvancedFilter ， Collection ，Array Comparison， Range.RemoveDuplicates和Application.Match 。 这些项目只存储在一列中，并且是500个唯一值的string（所以没有date可以使事情更尴尬）。 速度顺序是：

  1. AdvancedFilter，0.19秒
  2. 收集，1.83秒
  3. 删除重复，2.41秒
  4. arrays比较，37.28秒
  5. 比赛，38.75秒

AdvancedFilter

优点：

  • 惊人的快速，当然是最好的方法来删除重复。

缺点：

  • 需要输出到一个Range （所以可能需要一个隐藏的工作表）
  • 包含标题（所以需要对结果进行一些pipe理）
  • 如果没有进一步的编码，就无法确定一个项目与另一个项目匹配的位置（如果你试图find一个匹配的值，这个OP将不起作用）。

采集

优点：

  • 所有包含在VBA中（如果你不写结果到worksheet那么效果很好
  • 相当快
  • 标识匹配（例如，值，匹配项目的索引等）
  • 使您能够将附加数据存储在与唯一值关联的集合中（例如，重复发生的次数，其他行值等）

缺点：

  • 需要一个String作为一个唯一的键，（所以可能需要一些铸造，如果该键最初是一个Integer或Long Integer ，并且忘记将其转换为String进行查找，则会发生错误）
  • 需要捕获一个错误，以find一个重复的和一些开发人员不喜欢作为一种哲学（一个Dictionary对象会绕过这一点）。

RemoveDuplicates

优点：

  • 在锡上说什么 – 如果你只想从现有的Range删除重复的话，这是一个很棒的技术
  • 无需在别处输出结果
  • 没有问题的标题
  • 仍然可敬的速度

缺点：

  • 和AdvancedFilter ，没有进一步编码就无法识别匹配。

arrays比较

优点：

  • 对VBA的初学者很好，因为代码很容易理解和编写。
  • 识别匹配并保持唯一项目的运行计数
  • 与集合一样，将所有内容都保存在VBA中。

缺点：

  • 痛苦地缓慢（但是如果数据被sorting的话，速度有很大的提高空间）
  • 由于生成的数组是一维的，因此写入Worksheet更加困难，因此pipe理行可能会成为问题。 如果只有VBA让你ReDim的第一维…

比赛

优点：

  • 如果你只是想find一个单一的比赛将工作确定
  • 识别匹配

缺点：

  • 如果你有一个大的数据集，把水壶放在上面
  • 代码效率低下（但是像跳过已知重复的改进会大大的帮助）

所以，我想在pipe理重复项目时很难查看AdvancedFilters和Collections ，但是没有人的宝贝是丑陋的，所以请select。

如果您有兴趣testing代码如下： 

 Option Explicit Private mTimer As clsTimer Private mDataRanges As Collection Private Const ADV_FILTER_KEY As String = "AdvancedFilter" Private Const COLLECTION_KEY As String = "Collection" Private Const ARRAY_COMP_KEY As String = "Array Comparison" Private Const REMOVE_DUPES_KEY As String = "RemoveDuplicates" Private Const MATCH_KEY As String = "Match" Public Sub RunMe() Dim srcSht As Worksheet Dim outSht As Worksheet Dim lastCell As Range Dim loc As clsRanges 'Initialise Set mTimer = New clsTimer 'Idenfity the source data Set srcSht = ThisWorkbook.Worksheets("SourceData") Set outSht = ThisWorkbook.Worksheets("UniqueList") Set lastCell = srcSht.Cells(srcSht.Rows.count, "A").End(xlUp) 'Prepare the output sheet outSht.Cells.Clear outSht.Cells(1, 1).Value = "Type" outSht.Cells(2, 1).Value = "Secs" 'Define the source and output ranges Set mDataRanges = New Collection Set loc = New clsRanges loc.Create lastCell, outSht, 2, True mDataRanges.Add loc, ADV_FILTER_KEY Set loc = New clsRanges loc.Create lastCell, outSht, 3 mDataRanges.Add loc, COLLECTION_KEY Set loc = New clsRanges loc.Create lastCell, outSht, 4 mDataRanges.Add loc, ARRAY_COMP_KEY Set loc = New clsRanges loc.Create lastCell, outSht, 5 mDataRanges.Add loc, REMOVE_DUPES_KEY Set loc = New clsRanges loc.Create lastCell, outSht, 6 mDataRanges.Add loc, MATCH_KEY 'Find the unique values using different methods UsingAdvFilter UsingCollection UsingArrayComparison UsingRemoveDuplicates UsingMatch End Sub Private Sub UsingAdvFilter() Dim loc As clsRanges Dim v As Variant Dim rng As Variant Dim srcRange As Range Dim outRange As Range 'Start the clock mTimer.StartCounter 'Run the filter to write unique values Set loc = mDataRanges(ADV_FILTER_KEY) loc.SourceRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=loc.OutputRange, unique:=True 'Read the unique values into an array v = loc.OutputRange.CurrentRegion.Resize(, 1).Value 'Stop the clock loc.OutputRange.Offset(-1).Value = Round(mTimer.TimeElapsed / 1000, 2) 'Write the heading loc.OutputRange.Offset(-2).Value = ADV_FILTER_KEY loc.OutputRange.EntireColumn.AutoFit End Sub Private Sub UsingCollection() Dim col As Collection Dim data As Variant Dim key As String Dim item As Variant Dim v() As Variant Dim i As Long Dim loc As clsRanges 'Start the clock mTimer.StartCounter 'Read the source data into an array Set loc = mDataRanges(COLLECTION_KEY) data = loc.SourceRange.Value2 'Prepare error handler to trap duplicate keys On Error Resume Next 'Loop through the data array to find unique values Set col = New Collection For i = 1 To UBound(data, 1) 'Define the key (must be a String) key = CStr(data(i, 1)) 'Test if collection already contains the key 'If it doesn't an error 5 will be thrown item = col(key) If Err.Number = 5 Then 'key doesn't exist col.Add data(i, 1), key Err.Clear ElseIf Err.Number <> 0 Then 'trap any unplanned errors MsgBox Err.Description End End If Next 'Restore the error handler On Error GoTo 0 'Read the unique values into an array ReDim v(1 To col.count, 1 To 1) i = 1 For Each item In col v(i, 1) = item i = i + 1 Next 'Write the unique values loc.OutputRange.Resize(UBound(v, 1)).Value = v 'Stop the clock loc.OutputRange.Offset(-1).Value = Round(mTimer.TimeElapsed / 1000, 2) 'Write the heading loc.OutputRange.Offset(-2).Value = COLLECTION_KEY loc.OutputRange.EntireColumn.AutoFit End Sub Private Sub UsingArrayComparison() Dim loc As clsRanges Dim data As Variant Dim tmp() As Variant Dim v() As Variant Dim i As Long Dim c As Long Dim count As Long Dim isUnique As Boolean 'Start the clock mTimer.StartCounter 'Read the source data into an array Set loc = mDataRanges(ARRAY_COMP_KEY) data = loc.SourceRange.Value2 'Dimension the array which will temporarily store unique values ReDim tmp(1 To UBound(data, 1)) 'Set the unique counter - use 0 to prevent the loop running on first item. count = 0 'Loop through the data array For i = 1 To UBound(data, 1) 'Test if value is already contained in unique list 'by iterating through it until a match is found isUnique = True For c = 1 To count If data(i, 1) = tmp(c) Then isUnique = False Exit For End If Next 'If no match is found then add it to the temporary array 'and increment the count If isUnique Then count = count + 1 tmp(count) = data(i, 1) End If Next 'Trim the temporary array to the unique count size ReDim Preserve tmp(1 To count) 'Unfortunately we can't write a one-dimensional array to 'a Worksheet (without using some form of Transposition) 'so we'll copy it to a two-dimensional one. 'It would be easier if we could just Dim the tmp array 'in two dimensions, but ReDim only allows us to adjust the 'last dimension (ie column), so we can't deal with rows. ReDim v(1 To count, 1 To 1) For i = 1 To count v(i, 1) = tmp(i) Next 'Write the unique values loc.OutputRange.Resize(count).Value = v 'Stop the clock loc.OutputRange.Offset(-1).Value = Round(mTimer.TimeElapsed / 1000, 2) 'Write the heading loc.OutputRange.Offset(-2).Value = ARRAY_COMP_KEY loc.OutputRange.EntireColumn.AutoFit End Sub Private Sub UsingRemoveDuplicates() Dim loc As clsRanges Dim rng As Range Dim v As Variant Dim count As Long 'Start the clock mTimer.StartCounter 'Resize the output range to match the source data range Set loc = mDataRanges(REMOVE_DUPES_KEY) Set rng = loc.OutputRange.Resize(loc.SourceRange.Rows.count) 'Turn off screen updating to keep our test fair Application.ScreenUpdating = False 'Write the full source data to the output sheet rng.Value = loc.SourceRange.Value2 'Run the remove duplicates routine rng.RemoveDuplicates 1, xlNo 'Restore screen updating Application.ScreenUpdating = True 'Calculate size of range without the duplicates count = rng.Cells(rng.Rows.count, 1).End(xlUp).Row - loc.OutputRange.Row + 1 'Read the values into an array v = loc.OutputRange.Resize(count).Value 'Stop the clock loc.OutputRange.Offset(-1).Value = Round(mTimer.TimeElapsed / 1000, 2) 'Write the heading loc.OutputRange.Offset(-2).Value = REMOVE_DUPES_KEY loc.OutputRange.EntireColumn.AutoFit End Sub Private Sub UsingMatch() Dim data As Variant Dim lastPos As Long Dim searchRange As Range Dim isUnique As Boolean Dim loc As clsRanges Dim count As Long Dim i As Long Dim tmp() As Variant Dim v() As Variant 'Start the clock mTimer.StartCounter 'Read the source data into an array Set loc = mDataRanges(MATCH_KEY) data = loc.SourceRange.Value2 'Dimension the array which will temporarily store unique values ReDim tmp(1 To UBound(data, 1)) 'Prepare the loop parameters lastPos = UBound(data, 1) count = 0 For i = 1 To lastPos If i = lastPos Then 'no need to look for a match as it's the last one isUnique = True Else 'Define the search range to be one below the current item to the end. Set searchRange = loc.SourceRange.Cells(i + 1, 1).Resize(lastPos - i) isUnique = IsError(Application.Match(data(i, 1), searchRange, 0)) End If 'If there's no match, add the item to our uniques array If isUnique Then count = count + 1 tmp(count) = data(i, 1) End If Next 'Trim the temporary array to the unique count size ReDim Preserve tmp(1 To count) 'Same one-dimensional array issue as array method so transpose. ReDim v(1 To count, 1 To 1) For i = 1 To count v(i, 1) = tmp(i) Next 'Write the unique values loc.OutputRange.Resize(count).Value = v 'Stop the clock loc.OutputRange.Offset(-1).Value = Round(mTimer.TimeElapsed / 1000, 2) 'Write the heading loc.OutputRange.Offset(-2).Value = MATCH_KEY loc.OutputRange.EntireColumn.AutoFit End Sub

…为了完整性，这里是clsRanges代码： 

 Private mSrcRange As Range Private mOutRange As Range Public Sub Create(srcLastCell As Range, outSht As Worksheet, outCol As Long, Optional incHeader As Boolean = False) Dim ws As Worksheet Dim r As Long Dim c As Long Set ws = srcLastCell.Worksheet r = IIf(incHeader, 1, 2) c = srcLastCell.Column Set mSrcRange = ws.Range(ws.Cells(r, c), srcLastCell) Set mOutRange = outSht.Cells(3, outCol) End Sub Public Property Get SourceRange() As Range Set SourceRange = mSrcRange End Property Public Property Get OutputRange() As Range Set OutputRange = mOutRange End Property
Interesting Posts

Excel VBA – 表单显示和导入数据后提示密码

如何获得最早的dateExcel支持编程

将文本框中的值写入单行

获取列名称

如何查看/查看上一行或下一行

如果在没有纸张被识别时如何访问XSSF内容

将string附加到VBA中的粗体string

根据两列数据生成第三列序号

这些新颖的方法（也许是最好的方法？）在VBA中引用dynamic单元格？

谷歌表单字符限制