Question

我需要一些代码来查找B列中的重复项，然后如果找到了和列I，J＆amp; L.然后删除重复的行，只留下1个实例。

我在Sheet1上单击了一个按钮，代码需要在Sheet4上运行。

我目前有这个代码，它可以完美地完成任务，但它只适用于活动工作表，我似乎无法使其适用于不同的工作表。

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False      '### Excel wont update its screen while executing this macro. This is a huge performace boost
Dim SumCols() '### declare a second empty array for our sum columns
SumCols() = Array(9, 10, 12)         '### the second array stores the columns which should be summed up
'### the next line sets our range for searching dublicates. Starting at cell A2 and ending at the last used cell in column A
Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))
For Each cell In searchrange            '### now we start looping through each cell of our searchrange
    Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)   '### searches for a dublicate. If no dub exists, it finds only itself
    Do While Search.Address <> cell.Address     '### until we find our starting cell again, these rows are all dublicates

        For i = 0 To UBound(SumCols)    '### loop through all columns for calculating the sum
            '### next line sums up the cell in our starting row and its counterpart in its dublicate row
            Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i)))
        Next i                          '### go ahead to the next column

        Search.EntireRow.Delete         '### we are finished with this row. Delete the whole row
        Set Search = searchrange.Find(cell, after:=cell)    '### and search the next dublicate after our starting row
    Loop

Next                                    '### from here we start over with the next cell of our searchrange

                                        '### Note: This is a NEW unique value since we already deleted all old dublicates

Application.ScreenUpdating = True '### re-enable our screen updating
End Sub

所有帮助表示赞赏!!!!

Answer 1

假设您要对工作簿中的每个工作表执行操作，您只需要围绕其余代码包装另一个for each循环，然后指定它位于该范围内的工作表中。对于您要发布的代码，它看起来像这样：

Option Explicit

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  Dim SumCols()
  Dim ws As Worksheet
  SumCols() = Array(9, 10, 12)

  For Each ws In Worksheets
    Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))
    For Each cell In searchrange
      Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)
      Do While Search.Address <> cell.Address
        For i = 0 To UBound(SumCols)
            '### next line sums up the cell in our starting row and its counterpart in its dublicate row
            Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i)))
        Next i
        Search.EntireRow.Delete
        Set Search = searchrange.Find(cell, after:=cell)
      Loop
    Next cell
  Next ws
  Application.ScreenUpdating = True
End Sub

相关更改是额外的for each - 循环和更改

 Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))

到

 Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))

Answer 2

首先选择工作表，使其成为ActiveSheet：

Sheets("MergedData").Select

或者最好使用With（未测试）参考：

Option Explicit

Private Sub CommandButton1_Click()
    Dim searchrange As Range, cell As Range, Search As Range
    Dim I As Integer
    Dim SumCols()
    Application.ScreenUpdating = False
    SumCols() = Array(9, 10, 12)

    With Sheets("MergedData")
        Set searchrange = .Range(.Range("b1"), .Columns(2).Find(what:="*", after:=.Range("b1"), searchdirection:=xlPrevious))

        For Each cell In searchrange
            Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)

            Do While Search.Address <> cell.Address
                For I = 0 To UBound(SumCols)
                    .Cells(cell.Row, SumCols(I)) = CDbl(.Cells(cell.Row, SumCols(I))) + CDbl(.Cells(Search.Row, SumCols(I)))
                Next I

                Search.EntireRow.Delete
                Set Search = searchrange.Find(cell, after:=cell)
            Loop
        Next
    End With

    Application.ScreenUpdating = True
End Sub

合并重复项和总和列

2 个答案: