basıt bı sey ama yapamıyorum

[ozer07]

özet tablolar

merhaba oncelıkle boyle bır sıte olusturduğunuz ıcın herkese tesekkurler

sımdı gelelım konumuza basıt bır hesap defterı yapmak ıstedım ekte bunu verdım sımdı benım ıstedığım su ıkı tane tus atamak ıstıyorum ornegın ctrl a ve ctrl x ctrl a ya basınca a sutunundakı aynı ısımlerın toplam fıyatlarını kenarda ayrıca gostermesını ctrl x ye basıncada b sutunundakı aynı karakterlerın toplamının ayrıca gosterılmesını ıstıyorum yanı bır noktada sayfa ozetı gıbı bır sey

sımdıden herkese tesekkurler

 

[Merhum İdris SERDAR]

Dosyanız ekte.


.

 

[ozer07]

çok teşekkur ederım mukemmel olmus bu kadar cabuk olacağınızı tahmın etmıyordum

 

[Necdet]

Merhaba,

Soru Makro bölümünde sorulunca bende makrolu çözüm önermiştim.

Sub Üretici()
' Klavye Kısayolu: Ctrl+a
Sheets("Sayfa1").Select
Dim i, Son As Long
Application.ScreenUpdating = False
Range("G2:H65536").ClearContents
Columns("A:A").Range("A1:A55").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "G2"), Unique:=True
        
Son = [A65536].End(3).Row
For i = 3 To [G65536].End(3).Row
    Cells(i, "H") = "=SUMPRODUCT((A2:A" & Son & "=G" & i & ")*(E2:E" & Son & "))"
Next i
End Sub

Sub Ürün()
' Klavye Kısayolu: Ctrl+x
Sheets("Sayfa1").Select
Dim i, Son As Long
Application.ScreenUpdating = False
Range("K2:L65536").ClearContents
Columns("B:B").Range("A1:A55").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "K2"), Unique:=True
        
Son = [A65536].End(3).Row
For i = 3 To [K65536].End(3).Row
    Cells(i, "L") = "=SUMPRODUCT((B2:B" & Son & "=K" & i & ")*(C2:C" & Son & "))"
Next i
               
End Sub