☰

删除重复交易 - VBA 或函数

tag-icon • tag-icon microsoft-excel worksheet-function vba microsoft-excel-2016
删除重复交易 - VBA 或函数

交易集示例：

交易集示例

请注意显示的 3 笔交易。以绿色突出显示的两笔交易是我想要删除或标记的交易（无所谓）。

使用 VBA，代码太笨重了。代码运行需要很长时间，因为

  1. 我循环遍历 C 列中的每笔交易，直到找到负数。
  2. 如果不为零，则将 E 列设置为绝对值目标，否则设置为绝对值 D。
  3. 定义特定帐户的范围，以便我可以开始循环遍历它来查找步骤 2 中的值。
  4. 如果我找到该值，我会删除两行（一行包含负数，另一行不包含负数）。

抱歉，没有注释代码。这还没有 100% 完成。

Sub ReversalScrub()

Dim AccountNumber As String
Dim TargetAmount As Double
Dim TargetRange As Range
Dim Transactions As Range
Dim Transaction As Variant
Dim DeletionCount As Integer

    Set RawTransactions = Worksheets("RawTransactions")

    With RawTransactions
            Set Transactions = .Range("C1", .Range("C2").End(xlDown))

    End With

    TransactionRow = 2

    Do Until TransactionRow = Transactions.Rows.Count

        If Range("C" & TransactionRow).Value < 0 Then

            If Range("C" & TransactionRow).Offset(0, 2).Value < 0 Then

                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 2).Value)
            Else
                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 1).Value)
            End If

                AccountNumber = Range("C" & TransactionRow).Offset(0, -2).Value

                Set TargetRange = GetAccountRange(AccountNumber, RawTransactions)

                CurrentRow = TargetRange.Row

                Do Until CurrentRow = TargetRange.Rows.Count - 1
                    If (TargetAmount = Range("E" & CurrentRow).Value Or TargetAmount = Range("D" & CurrentRow).Value) Then
                        Range("A" & CurrentRow).EntireRow.Delete
                        Range("C" & TransactionRow).EntireRow.Delete
                        CurrentRow = CurrentRow - 2
                        Exit Do

                    End If
                    CurrentRow = CurrentRow + 1
                Loop
        End If
        TransactionRow = TransactionRow + 1
    Loop

End Sub

所以我决定编写一个函数来看看它是否会更快。

  1. F 列：检查交易是否为负数。如果是，则使用帐号、abs（D 列）、abs（E 列）创建密钥。=IF((C91<0),A91&ABS(D91)&ABS(E91))
  2. G列：创建关键帐号，D列，E列。=A91&D91&E91
  3. H 列：使用 检查 F 列是否存在于 G 中Match。=IFERROR(MATCH(F91,$G$1:G91,0),FALSE)
  4. 第 I 列：检查实际单元格行是否与步骤中的 H 列相匹配。=IFERROR(MATCH(ROW(H91),H:H,0),FALSE)
  5. J列：检查H或I是否为数字（MATCH输出），如果是，则它们被标记为逆转，用户可以删除它们。 =IF(OR(ISNUMBER(H91),ISNUMBER(I91)),"Reversal",IF(C91=0,"Zero",""))

问题是这也会导致我的电脑崩溃。我如何才能有效地找到重复项并删除它们而不删除第三行？

第二个解决方案示例：

第二个解决方案示例

答案1

这似乎适用于小数据集。尝试一下并根据需要进行调整。我用反转消息标记单元格 F。

这将查找 C 列，直到找到一个空单元格。如果有空单元格，则需要调整 Do Until 循环。

我正在跳过之前已标记的单元格（不是空单元格 F）

请注意，它只会将 1 个单元格标记为匹配。

Sub FlagReversals()

Dim MyExit As String
Dim PosLoc
Dim NegLoc
Dim NegAmt
Dim PosAmt

Range("C2").Select

  Do Until IsEmpty(ActiveCell)
    If ActiveCell.Value < 0 And IsEmpty(ActiveCell.Offset(0, 3).Value) Then
       NegLoc = ActiveCell.Address
       Acct = ActiveCell.Offset(0, -2)
       NegAmt = ActiveCell.Value
       PosAmt = Abs(ActiveCell.Value)
       MyExit = "False"
       Do Until MyExit = "True"
          If ActiveCell.Offset(-1, 0).Row > 1 Then
             ActiveCell.Offset(-1, 0).Select
          Else
             Range(NegLoc).Select
             ActiveCell.Offset(1, 0).Select
             MyExit = "True"
          End If
          If Acct = ActiveCell.Offset(0, -2) And IsEmpty(ActiveCell.Offset(0, 3).Value) And MyExit = "False" Then
             If PosAmt = ActiveCell.Value Then
               ' found the match (by account and value)
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & NegLoc
               PosLoc = ActiveCell.Address
               Range(NegLoc).Select
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & PosLoc
               MyExit = "True"
             End If
          End If
       Loop
    End If
  ActiveCell.Offset(1, 0).Select
  Loop

End Sub

编辑：当未找到匹配项时清理无限循环。

相关内容