arkadaşlar bir formül'e ihtiyaç duymaktayım.

[dragonflyvtr]

merhaba arkadaşlar ekteki exel'de sayfa 1 de istemiş olduğum a1 sutununa yazmış olduğum veya yazacak olduğum cari ye ait tüm hareketleri yevmiye kaydın dan tarih sıralamasına göre borç alacak şeklinde getirmesini istiyorum. konu ile alakalı bir formüle ihtiyacım var yardımlarınızı beklemekteyim.

 

[YUSUF44]

Öncelikle konu başlığını sorunuzu özetleyecek şekilde değiştirirseniz iyi olur.

Bu tür işlemleri formülle yapmak kullanışlı olmaz ve verilerin çokluğuna göre de çalışmanızı zorlaştırır. Tavsiyem makro kullanmanızdır.

Aşağıdaki kodları bir modüle kopyalayarak deneyiniz:

Sub hesap()
Set s1 = Sheets("Yevmiye Kaydı")
Set s2 = Sheets("Sayfa1")

son = s1.Cells(Rows.Count, "E").End(3).Row

For i = 3 To son
    If s1.Cells(i, "E") = s2.[A1] Then
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Cells(yeni, "A") = s1.Cells(i, "B")
        s2.Cells(yeni, "B") = s1.Cells(i, "C")
        s2.Cells(yeni, "C") = s1.Cells(i, "G")
        s2.Cells(yeni, "D") = s1.Cells(i, "H")
        s2.Cells(yeni, "E").FormulaR1C1 = "=IF(RC[-2]>RC[-1],RC[-2]-RC[-1],0)"
        s2.Cells(yeni, "F").FormulaR1C1 = "=IF(RC[-2]>RC[-3],RC[-2]-RC[-3],0)"
        s2.Cells(yeni, "E").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
        s2.Cells(yeni, "F").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    End If
Next
End Sub

 

[dragonflyvtr]

Kod da hata var üstad 320.01 yazıyorum 100.01 ile alakalı olan kayıtları da getiriyor bir sıkıntı var kodda sanırım.

 

[YUSUF44]

Kodda bir sıkıntı yok. Ben denediğimde 198 tane 320.01 kodlu satırı getirdi. Yevmiye sayfasında süzme yaptığımda da 198 adet veri olduğu görülüyor.

Dosyayı o haliyle yükleyin inceleyelim.

 

[Ömer BARAN]

Merhabalar.

Anlaşılmayan iki husus var:
-- YUSUF Bey'in kodlarının sorunsuz sonuç üretmesi gerekir.
-- C ve D sütununda aynı anda veri olmayacağına göre E ve F sütununda mevcut formüllerin sonucu
C ve D sütununun aynısı olacaktır. Bu nedenle E ve F sütunları için işlem öngörmedim.
-- E ve F sütunu için yapılmak istenilenin tam olarak açıklanırsa kod'a ilave yapılabilir elbette.

Ben de, FOR...NEXT döngüsü yerine FİLTRE yöntemiyle çalışan alternatif kod önerisinde bulunayım (zira veri yığını büyük olabilir).
-- Alt taraftan Sayfa1'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi zeçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın.
-- Sayfa1 A1 hücresine hesap kodu yazıldığında kod otomatik olarak çalışarak sonuç üretecektir.
.

[COLOR="red"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Call [B][COLOR="blue"]KEBIR[/COLOR][/B]
Target.Activate
[COLOR="Red"]End Sub[/COLOR]

[B][COLOR="Blue"]Sub KEBIR()[/COLOR][/B]
Set y = Sheets("Yevmiye Kaydı"): Set s = Sheets("Sayfa1")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If s.Cells(Rows.Count, 1).End(3).Row > 2 Then s.Range("A3:F" & Rows.Count).ClearContents
yson = y.Cells(Rows.Count, 2).End(3).Row
    y.Cells.AutoFilter
y.Range("A2:H" & yson).AutoFilter Field:=5, Criteria1:=s.[A1] & ""
If y.Cells(Rows.Count, 2).End(3).Row = 2 Then Exit Sub
y.Range("B3:C" & y.Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Copy
    s.[A3].PasteSpecial Paste:=xlPasteValues
y.Range("G3:H" & y.Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Copy
    s.[C3].PasteSpecial Paste:=xlPasteValues
s.Range("A3:A" & s.Cells(Rows.Count, 1).End(3).Row).NumberFormat = "dd.mm.yyyy"
y.Range("A2:H" & yson).AutoFilter Field:=5
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[YUSUF44]

Ömer Bey'in kodlarını görünce aklıma geldi. Benim kodlarda eski verilerin silinmesi yok. Eğer yeni kod sorguladığınızda önceki kodun verileri silinsin istiyorsanız benim koddaki "son" ile başlayan satırdan sonra aşağıdaki satırı ilave ediniz:

s2.Range("A3:F" & Rows.Count).Clearcontents