SumIF FormulaR1C1 удалить дубликаты + объединить - PullRequest
0 голосов
/ 16 января 2020

Я пытаюсь заставить приведенный ниже код работать для моего листа.

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

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...