vba 在列中查找重复项并从另一列添加其对应的值
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15414739/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Find duplicates in a column and add their corresponding values from another column
提问by user2170214
I have column A with staff ids and hours worked in column K.
我在 A 列有员工 ID 和在 K 列工作的时间。
I would like if a staff id appears more than once to add hours worked and put the result in another column corresponding to the first instance of that staff id and the duplicates being 0.
我想如果员工 ID 出现不止一次以添加工作时间并将结果放在与该员工 ID 的第一个实例相对应的另一列中，并且重复项为 0。
This is for a monthly report and there may be over 2k records at any point.
这是一份月度报告，任何时候都可能有超过 2000 条记录。
回答by StoriKnow
As everyone else said, a Pivot Table really is the best way. If you're unsure how to use a PivotTable or what it's good for, refer to this SO post where I explain in detail.
正如其他人所说，数据透视表确实是最好的方法。如果您不确定如何使用数据透视表或它有什么用处，请参阅我详细解释的这篇 SO 帖子。
Anyway, I put together the below VBA function to help get you started. It's by no means the most efficient approach; it also makes the following assumptions:
无论如何，我整理了以下 VBA 函数来帮助您入门。这绝不是最有效的方法；它还做出以下假设：
Sheet 1has all the dataAhas Staff IdBhas HoursCis reserved for Total HoursDwill be available for processing status output
Sheet 1拥有所有数据A有员工 IDB有小时C保留给总小时数D将可用于处理状态输出
This of course can all be changed very easily by altering the code a bit. Review the code, it's commented for you to understand.
这当然可以通过稍微改变代码很容易地改变。查看代码，它已注释以便您理解。
The reason a Statuscolumn must exist is to avoid processing a Staff Idthat was already processed. You could very alter the code to avoid the need for this column, but this is the way I went about things.
Status列必须存在的原因是为了避免处理Staff Id已经处理过的 a。您可以非常更改代码以避免需要本专栏，但这是我处理事情的方式。
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
后
回答by Kazimierz Jawor
Here is the solution for the data table located in range A1:B10 with headers and results written to column C.
这是位于区域 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
回答by Kazimierz Jawor
Try below code :
试试下面的代码：
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
BEFORE
前
AFTER
后
回答by Ravi Shankar Kota
Below code identifies duplicate value in a column and highlight with red. Hope this might be of some help.
下面的代码标识列中的重复值并用红色突出显示。希望这可能会有所帮助。
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
回答by DeerSpotter
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
this highlights the duplicates
这突出显示了重复项
