Объединение повторяющихся строк и добавление количеств в неизвестном диапазоне

Question

Я сканирую данные и хочу объединить повторяющиеся строки после завершения сканирования и нажать «Ввод». Ниже приведена копия того, как выглядят мои данные.

Column A  Column B       Column C
Barcode   Description     Qty
123123    double car       1
124125    triple car       1
123123    double car       1
123123    double car       1
124125    triple car       1

Ниже показано, как я хочу, чтобы мои данные выглядели

Column A  Column B       Column C
Barcode   Description     Qty
123123    double car       3
124125    triple car       2

Ниже приведена копия кода, который я использую.

Private Sub Workbook_Open()
    Application.OnKey "{ENTER}", "MyEnterEvent"
End Sub

Sub MyEnterEvent()

'Best used when first column has value on last row and first row has a value in the last column

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("Sheet2")
Set StartCell = Range("C2")

'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

'Select Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select

  ActiveWindow.SmallScroll Down:=-9
    Range("C100").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-98]C:R[-1]C)"
    Range("C101").Select

End Sub

Sub CombineDuplicateRowsAndSum()
    Set R = Application.Selection
    Set R = Application.InputBox("select one Range:", "CombineDuplicateRowsAndSum", R.Address, Type:=8)
    Set Dic = CreateObject("Scripting.Dictionary")
    arr = R.Value
    For i = 1 To UBound(arr, 1)
        Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
    Next
    R.ClearContents
    R.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
    R.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
    Application.ScreenUpdating = True
End Sub

Я новичок в кодировании, поэтому я просто взял несколько кодов и соединил их.

Answer 1

Или вы можете сделать это, используя Dictionary таким образом:

Sub CombineDuplicateRowsAndSum()

Application.ScreenUpdating = False

Dim R As Range, Dic As Object, arr As Variant, i As Long, v() As Variant, j As Long

Set R = Application.Selection
Set R = Application.InputBox("select one Range:", "CombineDuplicateRowsAndSum", R.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")

arr = R.Value
ReDim v(1 To UBound(arr, 1), 1 To UBound(arr, 2))

For i = 1 To UBound(arr, 1)
    If Not Dic.Exists(arr(i, 1)) Then
        j = j + 1
        Dic(arr(i, 1)) = j
        v(j, 1) = arr(i, 1)
        v(j, 2) = arr(i, 2)
    End If
    v(Dic(arr(i, 1)), 3) = v(Dic(arr(i, 1)), 3) + 1
Next

R.ClearContents
R.Resize(j, UBound(v, 2)).Value = v

Application.ScreenUpdating = True

End Sub