Excel VBA 코드를 사용하여 열에서 중복 된 항목을 찾고 다른 열에서 해당 값을 추가하십시오.

Question

누군가가이 문제를 해결할 수 있기를 바랍니다. 나는 직원 ID가있는 열 A를 가지고 있고 다른 시간대에 K 열 근무를하고 있습니다. 직원 ID가 목록에 두 번 이상 나타나며 확인할 수있는 Excel VBA의 방법이 있는지 알고 싶습니다. 각 직원 ID가 두 번 이상 나타나면 해당 직원의 총 시간을 합산하고 해당 직원 ID의 첫 번째 인스턴스에 해당하는 다른 열에 결과를 입력하고 중복 값은 0입니다.

월별 보고서의 경우 2k가 넘는 레코드가있을 수 있습니다.

도움이 될 것입니다. 사전에

감사

PS는 - 그것은 VBA에 올 때 난 그냥 중간입니다.

Answer 1

다른 사람들처럼 피벗 테이블이 가장 좋습니다. 피벗 테이블을 사용하는 방법이나 유용한 정보가 확실하지 않은 경우 refer to this SO post where I explain in detail

어쨌든, 시작하기 쉽도록 아래의 VBA 함수를 조합했습니다. 결코 가장 효율적인 방법은 아닙니다. 또한 다음과 같은 가정한다 :

• Sheet 1

  는

• A는
• B이 시간
• C을 가지고 총 시간을 위해 예약되어 직원 ID가 모든 데이터가를
• 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

여기에 헤더와 결과가 C 열에 쓰여진 A1 : B10 범위에있는 데이터 테이블의 솔루션입니다.코드 아래

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 

AFTER

중복을 강조 표시