宏用于检查工作簿中的重复行和总和列B（金额）并删除重复项

Question

所有

我正在处理一个用户表单的命令按钮上使用的宏，因此在这种情况下，excel表中的枢轴表或公式等其他可能性将无效，至少不是因为我是什么试图做。

此用户表单将由网络上的多台计算机使用，并编辑通过用户表单从用户指定的多个不同工作簿。

我需要一个宏来比较每一行（C列和D列）和用户指定的行范围。然后将列（B）中重复行数量的值相加，并删除剩余的重复行，留下一行。

我的问题是，如果我能在这个宏的代码中得到任何帮助，由于某种原因，这个给了我很多麻烦或指向我正确的方向。

以下是检查重复和删除重复项的代码：

    Sub TestForDups()

   Dim LLoop As Integer
   Dim LTestLoop As Integer
   Dim Lrows As Integer
   Dim LRange As String
   Dim LCnt As Integer

   'Column values
   Dim LColA_1, LColB_1, LColC_1, LColD_1, LColE_1, LColF_1, LColG_1, LColH_1 As String
   Dim LColA_2, LColB_2, LColC_2, LColD_2, LColE_2, LColF_2, LColG_2, LColH_2 As String

   'Test first 2000 rows in spreadsheet for duplicates (delete any duplicates found)
   Lrows = 2000
   LLoop = 2
   LCnt = 0

   'Check first 2000 rows in spreadsheet
   While LLoop <= Lrows
      LColA_1 = "A" & CStr(LLoop)
      LColB_1 = "B" & CStr(LLoop)
      LColC_1 = "C" & CStr(LLoop)
      LColD_1 = "D" & CStr(LLoop)
      LColE_1 = "E" & CStr(LLoop)
      LColF_1 = "F" & CStr(LLoop)
      LColG_1 = "G" & CStr(LLoop)
      LColH_1 = "H" & CStr(LLoop)

      If Len(Range(LColA_1).Value) > 0 Then

         'Test each value for uniqueness
         LTestLoop = LLoop + 1
         While LTestLoop <= Lrows
            If LLoop <> LTestLoop Then
               LColA_2 = "A" & CStr(LTestLoop)
               LColB_2 = "B" & CStr(LTestLoop)
               LColC_2 = "C" & CStr(LTestLoop)
               LColD_2 = "D" & CStr(LTestLoop)
               LColE_2 = "E" & CStr(LTestLoop)
               LColF_2 = "F" & CStr(LTestLoop)
               LColG_2 = "G" & CStr(LTestLoop)
               LColH_2 = "H" & CStr(LTestLoop)

               'Value has been duplicated in another cell (based on values in columns A to H)
               If (Range(LColA_1).Value = Range(LColA_2).Value) _
                And (Range(LColB_1).Value = Range(LColB_2).Value) _
                And (Range(LColC_1).Value = Range(LColC_2).Value) _
                And (Range(LColD_1).Value = Range(LColD_2).Value) _
                And (Range(LColE_1).Value = Range(LColE_2).Value) _
                And (Range(LColF_1).Value = Range(LColF_2).Value) _
                And (Range(LColG_1).Value = Range(LColG_2).Value) _
                And (Range(LColH_1).Value = Range(LColH_2).Value) Then

                  'Delete the duplicate
                  Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
                  Selection.Delete Shift:=xlUp

                  'Decrement counter since row was deleted
                  LTestLoop = LTestLoop - 1

                  LCnt = LCnt + 1

               End If

            End If

            LTestLoop = LTestLoop + 1
         Wend

      End If

      LLoop = LLoop + 1
   Wend

   'Reposition back on cell A1
   Range("A1").Select
   MsgBox CStr(LCnt) & " rows have been deleted."

End Sub