excel - 在列中查找重复项并从另一列添加它们的对应值

Question

我在 A 列有员工 ID 和工作时间在 K 列。

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

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

Answer 1

正如其他人所说，数据透视表确实是最好的方法。如果您不确定如何使用数据透视表或它有什么用处，请参阅我详细解释的这篇 SO 帖子。

无论如何，我整理了以下 VBA 函数来帮助您入门。这绝不是最有效的方法。它还做出以下假设：

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

当然，这一切都可以通过稍微更改代码来轻松更改。查看代码，它已被注释以供您理解。

Status列必须存在的原因是为了避免处理Staff Id已经处理过的 a。您可以更改代码以避免需要此专栏，但这是我做事的方式。

代码

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

试试下面的代码：

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 3

这是位于范围 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 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

这突出了重复项