Я пытаюсь заставить приведенный ниже код работать для моего листа.
Sub main()
Dim helperRng As Range, dataRng As Range
Dim colToFilter As String
Dim colsToSumUp As Long
With Worksheets("Transactions") '<== change "Sheet01" as per your actual sheet name
Set dataRng = .Range("A3:K3").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
colToFilter = "A" ' set here the column header you want to sum up on
colsToSumUp = 5 ' number of adjacent columns to sum up with
Set helperRng = dataRng.Offset(, .UsedRange.Columns.Count + 1).Resize(, 1) 'localize "helper" cells
first column out of sheet used range
With helperRng
.FormulaR1C1 = "=RC" & Cells(1, colToFilter).Column 'make a copy of the values you want to sum up on
.Offset(, 1).FormulaR1C1 = "=if(countif(R1C[-1]:RC[-1], RC[-1])=1,1,"""")" 'localize with "1" first occurrence of each unique value
With .Offset(, 2).Resize(, colsToSumUp)
.FormulaR1C1 = "=sumif(C" & helperRng.Column & ", RC" & helperRng.Column & ",C[" & Cells(1, colToFilter).Column - helperRng.Column - 1 & "])" 'sum up in adjacent columns
.Value = .Value 'get rid of formulas
End With
.Offset(, 1).SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Delete 'delete rows with repeted values you want to sum up on
dataRng.Columns(2).Resize(.Rows.Count, colsToSumUp).Value = .Offset(, 2).Resize(.Rows.Count, colsToSumUp).Value 'copy summed up values from "helper" cells
helperRng.Resize(, 1 + 1 + colsToSumUp).Clear 'clear "helper" cells
End With
End With
End Sub
По сути, я хочу, чтобы ik искал дубликаты в столбце A и суммировал значения в столбце E и объединял текст в столбцы F: J