vba ile yürüyen bakiye oluşturmak

[planlamaci]

Arkadaşlar merhaba,

ekteki excel dosyasında borç ve alacak sütunlarım var A sütunu sabit dolu sütunum ama satır sayım değişebiliyor.

Yapmak istediğim bir buton koymak butona bastığımda ilk dolu satıra borç ve alacağın farkını yazdırmak sonraki en son dolu satıra kadar iste bir önceki borç alacağı üzerine ekleyerek son bakiyeyi almak istiyorum.

bu konuda yardımcı olabilirmisiniz.

 

[tahsinanarat]

aşağıdaki kodu deneyiniz

Kodlar Korhan Ayhan hocama ait kodlardır
F sutunu hücre biçimi isteği uyarlanmış dan aşağıda yazılı olanı seçiniz
#.##0 _T_L;[Kırmızı]-#.##0 _T_L
F2 Hücresine yazılan formül : =EĞER(C2="";"";TOPLA($D$12)-TOPLA($E$1:E2)) olup son dolu satıra kadar devam etmektedir, FormulasToValues satırını kaldırırsanız formüller hücrede görünür, bu şekilde kullanırsanız formüller değere dönüştürülür.

Sub formulyaz()
Dim sat As Long, i As Long
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
For i = 2 To sat
    Sheets("Sayfa1").Cells(i, "F").Formula = "=IF(RC[-3]="""","""",SUM(R1C4:RC[-2])-SUM(R1C5:RC[-1]))"
Next i
FormulasToValues
End Sub
Sub FormulasToValues()
'
' Replace all formulas with values
'
WCount = Worksheets.Count
For i = 1 To WCount
  If Worksheets(WCount - i + 1).Visible Then
    Worksheets(WCount - i + 1).Select
    RCount = ActiveCell.SpecialCells(xlLastCell).Row
    CCount = ActiveCell.SpecialCells(xlLastCell).Column
    For j = 1 To RCount
      For k = 1 To CCount
        Worksheets(WCount - i + 1).Cells(j, k) = Worksheets(WCount - i + 1).Cells(j, k).Value
      Next k
    Next j
  End If
Next i
End Sub

 

[assenucler]

Teşekkürler üstadım. İyi hafta sonları ve dinlenceler..

Sevgi ve saygılar.

 

[koboy]

Bu kod işime yaradı ancak eksi bakiye olunca g suyuna nasıl yazdırabilirim

Sub formAs Long, i As Long
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
For i = 2 To sat
    Sheets("Sayfa1").Cells(i, "F").Formula = "=IF(RC[-3]="""","""",SUM(R1C4:RC[-2])-SUM(R1C5:RC[-1]))"
Next i
FormulasToValues
End Sub
Sub FormulasToValues()
'
' Replace all formulas with values
'
WCount = Worksheets.Count
For i = 1 To WCount
  If Worksheets(WCount - i + 1).Visible Then
    Worksheets(WCount - i + 1).Select
    RCount = ActiveCell.SpecialCells(xlLastCell).Row
    CCount = ActiveCell.SpecialCells(xlLastCell).Column
    For j = 1 To RCount
      For k = 1 To CCount
        Worksheets(WCount - i + 1).Cells(j, k) = Worksheets(WCount - i + 1).Cells(j, k).Value
      Next k
    Next j
  End If
Next i
End Sub

[/QUOTE]