Gelişmiş filtre ve Etopla fonksiyon kodundaki hata ve ilave

[irfancantr]

Herkese iyi akşamlar,

Szilerden ricam sayfada bulunan D hücresindeki isimlerin I hücresindeki karşılık değerlerinin toplamlarını M ve N hücrelerine yazdırabilmek,

Kod:
Application.ScreenUpdating = False
Range("P:Q").ClearContents
[W1] = "FİRMALAR"
[N5] = "TOPLAMLAR"
a = [D2500].End(3).Row
Range("D6:K" & a).Copy [W2]
i = [W65536].End(3).Row
Range("W1:W" & i).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("M5"), Unique:=True
For J = 5 To [M65536].End(3).Row
Cells(J, "N") = WorksheetFunction.SumIf(Range("W:W"), Cells(J, "M"), Range("AA:AA"))
Next
Range("W:AE").ClearContents
Range("M:AE").Borders.LineStyle = 0
Range("M:AE").Borders.LineStyle = 0
Range("M5:N" & J - 1).Borders.LineStyle = 1
[N5] = "TOPLAMLAR"
Application.ScreenUpdating = True
Bu kodların neresinde hata yapıyorum anlamadım (zetan kodları başka yerden kırpa kırpa zoraki bu hale ancak getirebildim) ne şekilde daha rahat düzenleyebilir,

İkinci olarak E ve yine aynı şekilde I sütunlarında ki topla.çarpım şeklini hemen yanı olan P ve Q sütunları tek seferde alabilir miyiz?

P ve Q sütunlarına bilgi çekeceğimiz için yukarıda ki kod başlı başına değişmek zorunda kalacak sanırım

Yardımlarınız için şimdiden çok teşekkür ederim...


Not: Az önce ki mesajımda aceleden başlığı yazarken saçmaladım, bu konuda özür dilerim...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Yalnız sorunuzun TOPLA.ÇARPIM fonksiyonu ile bağlantısını göremedim. Gelişmiş filtre ve ETOPLA fonksiyonunu kullanarak kod düzenlemişsiniz. Başlığınızı bu yönde değiştirirseniz faydalı olacaktır.

Option Explicit
 
Sub ÖZET_TABLO()
    Dim X As Integer
 
    Application.ScreenUpdating = False
 
    Range("M5:Q65536").ClearContents
 
    If Range("D65536").End(3).Row > 5 Then
    Range("D5:D" & Range("D65536").End(3).Row).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Range("M5"), Unique:=True
    Range("N5") = "TOPLAMLAR"
    End If
 
    If Range("E65536").End(3).Row > 5 Then
    Range("E5:E" & Range("E65536").End(3).Row).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Range("P5"), Unique:=True
    Range("Q5") = "TOPLAMLAR"
    End If
 
    For X = 6 To Range("M65536").End(3).Row
        Cells(X, "N") = WorksheetFunction.SumIf(Range("D:D"), Cells(X, "M"), Range("I:I"))
    Next
 
    If Range("M5") <> "" Then Range("M5:N" & X - 1).Borders.LineStyle = 1
 
 
    For X = 6 To Range("P65536").End(3).Row
        Cells(X, "Q") = WorksheetFunction.SumIf(Range("E:E"), Cells(X, "P"), Range("I:I"))
    Next
 
    If Range("P5") <> "" Then Range("P5:Q" & X - 1).Borders.LineStyle = 1
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[irfancantr]

Teşekkür ederim sayın Korhan Ayhan hocam, sayenizde firma vega programından vazgeçme aşamasında