通过求和和删除来组合重复的条目

时间:2015-02-11 15:08:45

标签: excel vba

我有一张包含以下信息的工作表

Date      |      Min Worked      |      Job Number
2/4/2015           500                     123
2/4/2015           100                     123
2/4/2015           200                     321
2/5/2015           300                     321
2/5/2015           100                     123
2/5/2015           100                     123

我想将具有相同日期和工作号的任何条目的分钟组合起来,并删除附加内容。所以在运行VBA后,它看起来像这样

Date      |      Min Worked      |      Job Number
2/4/2015           600                     123
2/4/2015           200                     321
2/5/2015           300                     321
2/5/2015           200                     123

我尝试过的代码没有任何成功。任何帮助将不胜感激。

1 个答案:

答案 0 :(得分:0)

tigeravatar是正确的,使用Access查询这样做是最好的方法(更容易维护)。如果你真的需要/想要在VBA中这样做,你需要做类似的事情:

Sub Condense()
    Dim i as long
    Dim ref as string
    Dim total as long 'switch to double if Min can have fractional values
    Dim o as long

    Application.ScreenUpdating = False 'Just always a good practice to use this
    i = 2 'assumes you have headers in row 1, if not use 1
    Do while Range("A" & i).value <> "" 'Assumes Dates are in column A
        If ref = Range("A" & i).value & "-" & Range("C" & i).value then
            'Match, update total
            total = total + Range("B" & i).Value

            'Remove the duplicate row. Note in this case we don't update i as what is currently the i+1 -th row becomes row i after the delete
            Range(i & ":" & i).EntireRow.Delete
        Else
            'Check for macro just starting
            If o <> 0 then
                'new Date-Job combo. Output current total
                Range("B" & o).value = total
            End If 'else we're on the first time through the loop and just need to update o & ref
            'Update o & ref
            o = i
            ref = Range("A" & i).value & "-" & Range("C" & i).value
        End If
        'Update i
        i = i + 1
        End If
    Loop

Application.ScreenUpdating = True
End Sub