2015-02-11 98 views
-1

合并重复条目我有以下信息通过总结和删除

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

请编辑这个问题,已经尝试过,什么都不起作用。 – 2015-02-11 15:12:12

+0

这听起来像可以使用数据透视表进行汇总的布局类型。你有没有理由不使用数据透视表? – user3561813 2015-02-11 15:22:22

+0

我正在努力。 – 2015-02-11 15:25:52

回答

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