在列中查找重复项，并从另一列添加其对应的值

Question

我有A列，其中有员工ID，小时数在K列。

我想如果一个职员ID多次出现以增加工作小时数，并将结果放在与该职员编号的第一个实例相对应的另一列中，且重复项为0。

这是一份月度报告，任何时候都可能有超过2k的记录。

Answer 1

正如其他人所说，数据透视表确实是最好的方式。如果您不确定如何使用数据透视表或其有用的内容，refer to this SO post where I explain in detail。

无论如何，我将以下VBA功能放在一起，以帮助您入门。这绝不是最有效的方法;它还做出以下假设：

  

  
• Sheet 1拥有所有数据
  
• A有员工身份
  
• B有营业时间
  
• C仅限总时数
  
• D可用于处理状态输出
  

这当然可以通过稍微改变代码来轻松改变。查看代码，它被评论为您理解。

必须存在Status列的原因是为了避免处理已处理的Staff Id。您可以非常改变代码以避免使用此列，但这是我处理事情的方式。

<强> CODE

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

<强> BEFORE

<强> AFTER

Answer 2

以下是位于A1：B10范围内的数据表的解决方案，其中标题和结果写入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

下面的代码标识列中的重复值，并用红色突出显示。希望这会有所帮助。

  iLastRow = Cells(chosenExcelSheet.Rows.Count, 1).End(xlUp).Row 'Determine the last row to look at     
    Set rangeLocation = Range("A1:A" & iLastRow)

    'Checking if duplicate values exists in same column
        For Each myCell In rangeLocation
            If WorksheetFunction.CountIf(rangeLocation, myCell.Value) > 1 Then
                myCell.Interior.ColorIndex = 3'Highlight with red Color
            Else
                myCell.Interior.ColorIndex = 2'Retain white Color
            End If
        Next

Answer 5

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

这突出了重复项