如何从 VBA 中的表中获取唯一行？

Posted 2023-03-29

【中文标题】如何从 VBA 中的表中获取唯一行？

【英文标题】：How to get unique rows from table in VBA?

【发布时间】：2021-08-04 11:00:28

【问题描述】：

我正在寻找建议，如何解决以下问题在 VBA。

我有一个包含 4 列和超过 10000 行的“tableA”，我只需要将唯一行提取到“tableB”，但基于 Col1 和 Col4（无论我在 Col2 和 Col3 中有什么值）-检查下面链接中的图像，黄色行是唯一的，其余的则不是。

对于单个列，我可以使用“.RemoveDuplicates”轻松获取唯一值，但我不知道如何根据两列或更多列获取唯一行。我也可以通过选择 Col1 和 Col4 并使用删除重复项在 Power Query 中实现这一点，但我不能在此处使用 Power Query，需要仅在 VBA 中实现。

VBA 应该读作：

检查 A2 和 D2，如果这些值的组合是唯一的，则存储在内存中。 检查 A3 和 D3，如果组合值不是 A2 和 D2 的重复，则存储在内存中。 检查 A4 和 D4，如果值的组合不与 A2 D2 和 A3 D3 重复，则存储在内存中。 检查表中的所有行 .... 将唯一行粘贴到表 B

或者如果您知道任何其他逻辑，我也将不胜感激。

谢谢！

Snip of tables A and B

【问题讨论】：

.RemoveDuplicates Columns:=Array(1, 4), Header:=xlNo 根据您的图片生成表格。

同意@DarrenBartrup-Cook。您可能需要对结果进行排序才能完全获得您所显示的内容。但是仅选择两列的结果与将它们连接起来的结果相同。

【参考方案1】：

如果您需要 VBA 解决方案来删除唯一的 A:D 值，请尝试以下代码：

Sub UniqueRows()
'it needs a reference to `Mirosoft Scripting Runtime`
 Dim sh As Worksheet, lastR As Long, arr, arrFin, arrEl, i As Long
 Dim dict As New Scripting.Dictionary
 
 Set sh = ActiveSheet ' use here your necessary sheet
 lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row in A:A
 arr = sh.Range("A2:D" & lastR).Value      'Put the range in an array
 ReDim arrFin(1 To 2, 1 To UBound(arr))    'redim the final array
 
 For i = 1 To UBound(arr)
    If Not dict.Exists(arr(i, 1) & "," & arr(i, 4)) Then
        dict.Add arr(i, 1) & "," & arr(i, 4), 1 'keep only the unique cases
    End If
 Next i
 'build an array from the dictionary keys:
 For i = 0 To dict.count - 1
    arrEl = Split(dict.Keys(i), ",")
    arrFin(1, i + 1) = arrEl(0): arrFin(2, i + 1) = arrEl(1)
 Next i
 ReDim Preserve arrFin(1 To 2, 1 To i) 'redim the array to the exact number of real elements
 'drop the array content in the range you need:
 sh.Range("F2").Resize(UBound(arrFin, 2), 2).Value = Application.Transpose(arrFin)
End Sub

代码将在同一张表中返回处理后的结果，从“F2”单元格开始。代码可以很容易地适应返回到任何你需要的地方。

如果不熟悉添加引用，请在运行上面的代码之前运行下一个代码。它会自动添加必要的引用：

Sub addScrRunTimeRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub

这项工作可以在没有参考的情况下完成，但我认为最好拥有它以便从 Intellisense 建议中受益。