VBA / Excel

[roket adam]

Selam,

aha bunun aynısını yapmam gerekiyor:

http://answers.microsoft.com/en-us/office/forum/office_2013_release-excel/remove-duplicate-rows-with-sum-of-a-column-in/49067592-1b6f-4be7-92db-fcb771b978d0?auth=1

Fakat karşılaştıracağı column'lar G sutunu olacak, toplayacağı column da I sütunu olacak. Oradaki kodu bir türlü bu şekilde modifiye edemedim. Bu konuya el atabilecek olan var mı?

--

Sub mcr_Collect_Unique()
Dim ws As Worksheet, wsu As Worksheet
Set ws = ActiveSheet
Set wsu = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Cells(1, 1).CurrentRegion.Copy Destination:=wsu.Cells(1, 1)
With wsu.Cells(1, 1).CurrentRegion
With .Cells.Resize(.Rows.Count, .Columns.Count)
.RemoveDuplicates Columns:=Array(1, 4, 5), Header:=xlYes
Debug.Print Application.Count(wsu.Columns(6))
With .Cells(2, 6).Resize(Application.Count(wsu.Columns(6)), 1)
.FormulaR1C1 = "=SUMIFS('" & ws.Name & "'!C,'" & ws.Name & _
"'!C[-5],RC[-5],'" & ws.Name & "'!C[-2],RC[-2],'" & ws.Name & _
"'!C[-1],RC[-1])"
'.Cells = .Value
End With
End With
End With
End Sub

[roket adam]

Sub mcr_Collect_Unique()
Dim ws As Worksheet, wsu As Worksheet
Set ws = ActiveSheet
Set wsu = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Cells(1, 1).CurrentRegion.Copy Destination:=wsu.Cells(1, 1)
With wsu.Cells(1, 1).CurrentRegion.Offset(1, 0)
With .Cells.Resize(.Rows.Count - 1, .Columns.Count)
.RemoveDuplicates Columns:=Array(7), Header:=xlYes
With .Cells(2, .Columns.Count).Resize(Application.Count(wsu.Columns(9)), 1)
.FormulaR1C1 = "=SUMIFS('" & ws.Name & "'!C,'" & ws.Name & _
"'!C[-6],RC[-6],'" & ws.Name & "'!C[-3],RC[-3],'" & ws.Name & _
"'!C[-2],RC[-2])"
.Cells = .Value
End With
End With
End With
End Sub

Bu şekilde istenen deduplication'u yapıyor fakat dedup edilen I sutunundaki itemleri bir türlü toplamayıp kafasına göre gösteriyor alet. Delirecem.