Kümülatif liste hazırlama

[hakaco]

mevcut bır tıcarı yazılımdan ekli dosyada gösterdıgım gıbı bır lıste alıyorum ben bunu kumulatıf olarak toplamlı halını ıstıyorum onuda ıstenen dıye belırttım bunu yapabılecegım bır kod yazılarbılırmı?

yardımlarınız ıcın sımdıden tesekkurler...

 

[Orion1]

Merhaba. G5 Hücresine aşağıdaki formülü yazınız ve aşağı dopru kopyalayınız.:cool.
Ekli dosyayı inceleyiiniz.

=TOPLA.ÇARPIM(($A$5:$A$11=F5)*($C$5:$C$11="satılan")*($B$5:$B$11))-TOPLA.ÇARPIM(($A$5:$A$11=F5)*($C$5:$C$11="alınan")*($B$5:$B$11))

 

[hakaco]

merhaba gönderdıgınız dosyayı inceledim
sanırım anlatımımda eksıklık vardı
mevcut dediğim bir sheette istenen dediğim başka bir sheette olacak ve aynı isimde olanlar yalnzca bir tane yazacak ve karsısında toplamı yazacak

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz. Butona basıyorsunuz f ve g sütunlarına dökümü çıkarıyor.
Dosya güncellendi.
Koşullu biçimlendirme yapıldı.

Sub kumulatif()
Dim sat As Long, sonsat As Long, i As Long
Sheets("Sayfa1").Select
Range("F5:G65536").ClearContents
sat = 5
sonsat = Cells(65536, "A").End(xlUp).Row
If sonsat < 5 Then Exit Sub
Application.ScreenUpdating = False
For i = 5 To sonsat
    If WorksheetFunction.CountIf(Range("A5:A" & i), Cells(i, "A").Value) = 1 Then
        Cells(sat, "F").Value = Cells(i, "A").Value
        If Cells(i, "C").Value = "satılan" Then
            Cells(sat, "G").Value = Cells(i, "B").Value
            sat = sat + 1
            Else
            Cells(sat, "G").Value = Cells(i, "B").Value * -1
            sat = sat + 1
        End If
        Else
        Set k = Range("F5:F" & Cells(65536, "F").End(xlUp).Row).Find(Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If Cells(i, "C").Value = "satılan" Then
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value + Cells(i, "B")
                Else
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value - Cells(i, "B").Value
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı."
End Sub

 

[hakaco]

çok teşşekürler tam istediğim gibi oldu bu makronun içine değeri 0 olan hücreler mavi, değeri negatif olan hücreler kırmızı olsun diyebilirmiyiz

gercekten çok teşekkürler

 

[Orion1]

çok teşşekürler tam istediğim gibi oldu bu makronun içine değeri 0 olan hücreler mavi, değeri negatif olan hücreler kırmızı olsun diyebilirmiyiz

gercekten çok teşekkürler

Merhaba.
Dosya güncellendi.
0 değerli hücreler mavi - değerli hücreler kırmızı oldu.
Koşullu biçimlendirme uygulandı.
Önceki mesajımdan indirip inceleyebilirsiniz.

 

[hakaco]

ben bunuda makroya ekleyebılırmıyız dıye sormustum..
cunku ben yazdıgınız makroyu bır menu butonuna atadım ve farklı dosyalarda calıstırıyorum her dosyada bu kosullu bıcımlendırmeyı ayarlamaktansa bunuda makroya dahıl etmek daha dogru ve pratık olacaktır. ılgınıze teşekkurler...
ektekı resımdede özel düğme görunmektedır..
dosyanın son halı ektedır..

 

[Orion1]

Merhaba.
0 dan küçük değerler için kırmızı,0 değerleri içinde mavi oldu.
ekli dosyayı incleyiniz

Sub kumulatif()
Application.ScreenUpdating = False
Dim sat As Long, sonsat As Long, i As Long
Range("F2:G65536").Clear
sat = 2
sonsat = Cells(65536, "A").End(xlUp).Row
If sonsat < 2 Then Exit Sub
Application.ScreenUpdating = False
For i = 2 To sonsat
    If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A").Value) = 1 Then
        Cells(sat, "F").Value = Cells(i, "A").Value
        Cells(sat, "H").Value = Cells(i, "D").Value
        If Cells(i, "C").Value = "Satılan" Then
            Cells(sat, "G").Value = Cells(i, "B").Value
            If Cells(sat, "G").Value = 0 Then Cells(sat, "G").Interior.ColorIndex = 5
            If Cells(sat, "G").Value < 0 Then Cells(sat, "G").Interior.ColorIndex = 3
            sat = sat + 1
            Else
            Cells(sat, "G").Value = Cells(i, "B").Value * -1
            If Cells(sat, "G").Value = 0 Then Cells(sat, "G").Interior.ColorIndex = 5
            If Cells(sat, "G").Value < 0 Then Cells(sat, "G").Interior.ColorIndex = 3
            sat = sat + 1
        End If
        Else
        Set k = Range("F2:F" & Cells(65536, "F").End(xlUp).Row).Find(Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If Cells(i, "C").Value = "Satılan" Then
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value + Cells(i, "B")
                If Cells(k.Row, "G").Value = 0 Then Cells(k.Row, "G").Interior.ColorIndex = 5
                If Cells(k.Row, "G").Value < 0 Then Cells(k.Row, "G").Interior.ColorIndex = 3
                If Cells(k.Row, "G").Value > 0 Then Cells(k.Row, "G").Interior.ColorIndex = xlNone
                Else
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value - Cells(i, "B").Value
                If Cells(k.Row, "G").Value = 0 Then Cells(k.Row, "G").Interior.ColorIndex = 5
                If Cells(k.Row, "G").Value < 0 Then Cells(k.Row, "G").Interior.ColorIndex = 3
                If Cells(k.Row, "G").Value > 0 Then Cells(k.Row, "G").Interior.ColorIndex = xlNone
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı. <Powered by HaKaN>"
End Sub

 

[hakaco]

ilginize bilginize çok çok teşekkurler :hihoho:
ihtiyacı olanlar için dosyanın son halı ektedır...:icelim:

 

[evarbu]

slm arkadaşlar ben microsoft office 2007 kulanıyorum benim istediğim domunosun kulaln dığı kumulatif calışaması bilgisi olan varsa yardım ederseniz sevinirim

 

[evarbu]

Merhaba.
Dosya güncellendi.
0 değerli hücreler mavi - değerli hücreler kırmızı oldu.
Koşullu biçimlendirme uygulandı.
Önceki mesajımdan indirip inceleyebilirsiniz.

Merhaba.
0 dan küçük değerler için kırmızı,0 değerleri içinde mavi oldu.
ekli dosyayı incleyiniz

Sub kumulatif()
Application.ScreenUpdating = False
Dim sat As Long, sonsat As Long, i As Long
Range("F2:G65536").Clear
sat = 2
sonsat = Cells(65536, "A").End(xlUp).Row
If sonsat < 2 Then Exit Sub
Application.ScreenUpdating = False
For i = 2 To sonsat
    If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A").Value) = 1 Then
        Cells(sat, "F").Value = Cells(i, "A").Value
        Cells(sat, "H").Value = Cells(i, "D").Value
        If Cells(i, "C").Value = "Satılan" Then
            Cells(sat, "G").Value = Cells(i, "B").Value
            If Cells(sat, "G").Value = 0 Then Cells(sat, "G").Interior.ColorIndex = 5
            If Cells(sat, "G").Value < 0 Then Cells(sat, "G").Interior.ColorIndex = 3
            sat = sat + 1
            Else
            Cells(sat, "G").Value = Cells(i, "B").Value * -1
            If Cells(sat, "G").Value = 0 Then Cells(sat, "G").Interior.ColorIndex = 5
            If Cells(sat, "G").Value < 0 Then Cells(sat, "G").Interior.ColorIndex = 3
            sat = sat + 1
        End If
        Else
        Set k = Range("F2:F" & Cells(65536, "F").End(xlUp).Row).Find(Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            If Cells(i, "C").Value = "Satılan" Then
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value + Cells(i, "B")
                If Cells(k.Row, "G").Value = 0 Then Cells(k.Row, "G").Interior.ColorIndex = 5
                If Cells(k.Row, "G").Value < 0 Then Cells(k.Row, "G").Interior.ColorIndex = 3
                If Cells(k.Row, "G").Value > 0 Then Cells(k.Row, "G").Interior.ColorIndex = xlNone
                Else
                Cells(k.Row, "G").Value = Cells(k.Row, "G").Value - Cells(i, "B").Value
                If Cells(k.Row, "G").Value = 0 Then Cells(k.Row, "G").Interior.ColorIndex = 5
                If Cells(k.Row, "G").Value < 0 Then Cells(k.Row, "G").Interior.ColorIndex = 3
                If Cells(k.Row, "G").Value > 0 Then Cells(k.Row, "G").Interior.ColorIndex = xlNone
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı. <Powered by HaKaN>"
End Sub

slm arkadadaşl dominos kumulatif calışması nı oğrenmek istiyorum bilgin varsa sevinirim