vba - 需要更好的优化代码吗？

Question

需要大量优化的代码。我有一个项目，并且成功地使其与 vba 一起工作(主要是由 stackoverflow 程序员提供的帮助，谢谢)但今天我收到了反馈。它删除了记录中另外 2 个唯一条目，但我不知道为什么要删除它们。

我应用的算法

我使用了在 google 上找到的 COUNTIF 函数

    ="countif(A$1:A2,A3)=0" A3 is the active cell, Checks A2,A1 for dupes

如果 A 列中有重复项，则抛出 False；如果 A 列是唯一的，则抛出 True。我对 Countif 的理解是:它会检查该单元格中所有上述列的值，我的意思是让我们采用 A4。因此它会检查 A2、A1、A3 是否有重复项。类似地，A10 检查 A1 到 A9 并抛出 TRue 或 False。它正在工作，但我不知道出了什么问题。代码对某些条目不起作用。有时甚至对唯一条目显示 False。

由于我有更多的数据，因此应用这些公式需要更多的时间。我试图让它更干净、更优化。人们告诉我，它不是 c 或其他语言来使其优化，但我需要代码来使我的代码更加优化

我需要这些条件的代码，任何人都可以帮助我，因为我的计数失败了。这样做我有点无助。

1)我有一列，我应该检查该列中是否有重复项，如果重复则删除该行

2) 我的列中有 35000 个旧条目，每周都会附加 2000 个新条目。我需要从总共 37000 个条目中检查这 2000 个条目(当我们追加时，我们得到 35000+2000)，并且这些删除操作只需要对新追加的 2000 个条目执行，但它应该检查整个列的重复项

让我清楚地解释一下，我新添加了 2000 个条目，因此仅检查这些条目是否与 35000 个条目以及自身(2000 个条目)中的重复项进行检查，如果重复则将其删除，并且不进行重复操作应该对35000条旧数据进行处理。

我找到了一些代码，但他们甚至删除了 35000 个条目的重复项。我已经设置了范围，但即使它不起作用。任何人都可以帮助我编写花费更少时间的最佳代码吗？请谢谢

用我拥有的示例代码更新我的问题

   A       B            F       G        H       I              Y          
  PTY   39868.5         4       2       540      3      PTY39868.5425403 
  GTY   34446.1234      2       1       230      1      GTY34446.1234212301
  PTY   3945.678                2                2       PTY3945.67822
  GTY   34446.1234      2       1       230      1      GTY34446.1234212301
                  let us say these are old 35000 entries

对上面例子的解释。

以上为35000条条目。我必须检查 A、B、F、G、H、I 列中的重复项，如果它们相同，我必须删除该行，我不应该担心其他列 c、d 等，所以我所做的是我使用了一个未使用的 Y 列，并使用这些将这 6 列值连接到 Y 列中的 1 个

  = A2 & B2 & F2 & G2 & H2 &I2 with the respective columns

现在检查 Y 列是否重复并删除整行。据我所知，2003 年仅支持一栏。

请注意，即使 35000 个条目也可能有重复项，但我不应该删除它们。例如，您可以看到我的示例代码中的第 2 行和最后一行是重复的，但我不应该删除因为它是旧数据。

   A       B            F       G        H       I              Y          
  PTY   39868.5         4       2       540      3      PTY39868.5425403     'old 
  GTY   34446.1234      2       1       230      1      GTY34446.1234212301   'old
  PTY   3945.678                2                2       PTY3945.67822        'old
  GTY   34446.1234      2       1       230      1      GTY34446.1234212301    'old
  PTY    3945.678       1       1       230      2      PTY3945.678112302      'new
  PTY    39868.5        4       2       540      3      PTY39868.5425403       'new 
  PTY    3945.678       1       1       230      2      PTY3945.678112302      'new

现在请注意，新条目 PTY(从最后第二个)是原始记录(首先是 PTY)的重复项，因此我必须删除它。最后一个新条目是新条目本身的重复项，因此我应该删除甚至那个。所以在上面的代码中，我必须只删除最后两行，它们是原始记录的重复项，也从中删除。但不应该删除GTY，它是复制品，但在原始记录中。

我想我现在已经给出了清晰的观点。正在将它们连接成一个单元格。这是更好的接近方式吗？由于连接 40000 个条目只需 2 秒，我认为这并不重要，但任何更多的算法都非常值得赞赏

我听说 counif 将 45.00 和 45.00000 视为不同的，这可能是它的问题吗？因为我的数据中有小数点。我想我应该这样做

    = I2 & H2 & G2 & F2 & A2 & B2

哪个连接更好？这是我之前发布的还是其他的？

Answer 1

重大更新:

我觉得原来的问题让我很困惑——问题的逻辑可能有问题。以下假设您要删除重复条目的单元格，而不是整行。

• 如果 35000 条旧记录不包含重复项，那么您所需要做的就是删除整列中的所有重复项 - 只要从第 1 行开始，就不会存在删除任何“旧”行的风险因为其中不存在重复项。

这是一种方法:

Sub UniqueList()

Application.ScreenUpdating = False
Dim vArray As Variant
Dim i As Long, j As Long, lastrow As Long
Dim dictionary As Object
Set dictionary = CreateObject("scripting.dictionary")

lastrow = Range("A" & Rows.Count).End(xlUp).Row
vArray = Range("A1:A" & lastrow).Value

On Error Resume Next
For i = 1 To UBound(vArray, 1)
    For j = 1 To UBound(vArray, 2)
        If Len(vArray(i, j)) <> 0 Then
            dictionary(vArray(i, j)) = 1
        End If
    Next
Next

Columns("A:A").ClearContents
Range("A1").Resize(dictionary.Count).Value = _
Application.Transpose(dictionary.keys)

Application.ScreenUpdating = True

End Sub

• 如果由于某种奇怪的原因，35000 条旧记录确实包含重复项，而您只想允许这 35000 条记录这样做，那么您可以使用 2 个字典，但这将是一种不寻常的情况，因为您将处理旧记录记录与新记录不同...

Sub RemoveNewDupes()

Application.ScreenUpdating = False
Dim lastRow As Long
Dim varray As Variant
Dim oldDict As Object, newDict As Object
Set oldDict = CreateObject("scripting.dictionary")
Set newDict = CreateObject("scripting.dictionary")

On Error Resume Next
lastRow = Range("A" & Rows.Count).End(xlUp).Row

'Add old entries to dictionary
varray = Range("A1:A35000").Value
For i = 1 To UBound(varray, 1)
    oldDict.Add varray(i, 1), 1
Next

'Check for dupes
varray = Range("A35001:A" & lastRow).Value
For i = 1 To UBound(varray, 1)
    If oldDict.exists(varray(i, 1)) = False Then
        newDict.Add varray(i, 1), 1
    End If
Next

'Delete and slap back on the unique list
Range("A35001", "A" & Rows.Count).ClearContents
Range("A35001").Resize(newDict.Count).Value = _
Application.Transpose(newDict.keys)

Application.ScreenUpdating = True
End Sub

感谢 Reafidy 的建议并让我重新考虑这一点。