Excel VBA代码来查找列中的重复项，并从另一列中添加相应的值

我希望有人能够帮助我。 我有一个列A的工作人员的ID和他们的工作时间在另一个专栏K.有一些工作人员的ID不止一次出现在名单上，我想知道是否有一种方法在Excel VBA中，我可以检查如果每个员工ID出现不止一次，如果是，则将他们的总工作时间加起来，并将结果放在与该员工ID的第一个实例对应的另一列中，并且重复为0。

这是一个月度报告，任何时候都可能有超过2K条logging。

任何帮助将不胜感激。

提前致谢

PS – 在VBA方面，我只是一个中间人。

Answer 1

正如其他人所说，数据透视表确实是最好的方法。 如果您不确定如何使用数据透视表或其优点， 请参阅我在此详细解释的SOpost 。

无论如何，我把下面的VBAfunction放在一起，以帮助您开始。 这绝不是最有效的方法; 它也做出以下假设：

• Sheet 1包含所有数据
• A有员工编号
• B有小时
• C预留总时数
• D将可用于处理状态输出

这当然可以通过改变代码很容易地改变。 审查代码，它的评论让你明白。

“ Status列必须存在的原因是为了避免处理已处理的Staff Id 。 你可以改变代码，以避免这个列的需要，但这是我对事物的方式。

码

 Public Sub HoursForEmployeeById() Dim currentStaffId As String Dim totalHours As Double Dim totalStaffRows As Integer Dim currentStaffRow As Integer Dim totalSearchRows As Integer Dim currentSearchRow As Integer Dim staffColumn As Integer Dim hoursColumn As Integer Dim totalHoursColumn As Integer Dim statusColumn As Integer 'change these to appropriate columns staffColumn = 1 hoursColumn = 2 totalHoursColumn = 3 statusColumn = 4 Application.Calculation = xlCalculationManual Application.ScreenUpdating = False totalStaffRows = Sheet1.Cells(Rows.Count, staffColumn).End(xlUp).Row For currentStaffRow = 2 To totalStaffRows currentStaffId = Cells(currentStaffRow, staffColumn).Value 'if the current staff Id was not already processed (duplicate record) If Not StrComp("Duplicate", Cells(currentStaffRow, statusColumn).Value, vbTextCompare) = 0 Then 'get this rows total hours totalHours = CDbl(Cells(currentStaffRow, hoursColumn).Value) 'search all subsequent rows for duplicates totalSearchRows = totalStaffRows - currentStaffRow + 1 For currentSearchRow = currentStaffRow + 1 To totalSearchRows If StrComp(currentStaffId, Cells(currentSearchRow, staffColumn), vbTextCompare) = 0 Then 'duplicate found: log the hours worked, set them to 0, then mark as Duplicate totalHours = totalHours + CDbl(Cells(currentSearchRow, hoursColumn).Value) Cells(currentSearchRow, hoursColumn).Value = 0 Cells(currentSearchRow, statusColumn).Value = "Duplicate" End If Next 'output total hours worked and mark as Processed Cells(currentStaffRow, totalHoursColumn).Value = totalHours Cells(currentStaffRow, statusColumn).Value = "Processed" totalHours = 0 'reset total hours worked End If Next Application.ScreenUpdating = False Application.Calculation = xlCalculationAutomatic End Sub 

之前

后

Answer 2

以下是位于范围A1：B10中的数据表的解决scheme，其中标题和结果写入列C.

 Sub Solution() Range("c2:c10").Clear Dim i For i = 2 To 10 If WorksheetFunction.SumIf(Range("A1:a10"), Cells(i, 1), Range("C1:C10")) = 0 Then Cells(i, "c") = WorksheetFunction.SumIf( _ Range("A1:a10"), Cells(i, 1), Range("B1:B10")) Else Cells(i, "c") = 0 End If Next i End Sub 

Answer 3

尝试下面的代码：

 Sub sample() Dim lastRow As Integer, num As Integer, i As Integer lastRow = Range("A65000").End(xlUp).Row For i = 2 To lastRow num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0) If i = num Then Cells(i, 3) = WorksheetFunction.SumIf(Range("A1:A" & lastRow), Cells(i, 1), Range("B1:B" & lastRow)) Else Cells(i, 1).Interior.Color = vbYellow End If Next End Sub 

之前

后

Answer 4

 Sub SelectColoredCells() Dim rCell As Range Dim lColor As Long Dim rColored As Range 'Select the color by name (8 possible) 'vbBlack, vbBlue, vbGreen, vbCyan, 'vbRed, vbMagenta, vbYellow, vbWhite lColor = RGB(156, 0, 6) 'If you prefer, you can use the RGB function 'to specify a color 'Default was lColor = vbBlue 'lColor = RGB(0, 0, 255) Set rColored = Nothing For Each rCell In Selection If rCell.Interior.Color = lColor Then If rColored Is Nothing Then Set rColored = rCell Else Set rColored = Union(rColored, rCell) End If End If Next If rColored Is Nothing Then MsgBox "No cells match the color" Else rColored.Select MsgBox "Selected cells match the color:" & _ vbCrLf & rColored.Address End If Set rCell = Nothing Set rColored = Nothing End Sub 

这突出了重复