Kasiyer dosyasında belirli günleri kontrol etmek

[hamza9]

Ekte bir kasiyer dosyası var. Her gün ayrı bir sayfada kaydedilmiş. Bu dosyada belirli tarihleri kontrol edip her günden 4 tane veri alıp bunları 4 ayrı sütunda gün gün görebilmek istiyorum.
Alacağım veriler Total dinar, Total Usd, Computer Total, Difference

total dinar: TOTAL DN.(25+10+5) yazan satırdaki rakam
Total Usd: Total dinar rakamının iki altındaki veri. Kırmızı ile yazılan rakam (bu verinin olduğu satırda bir açıklama veya isim yok)
Computer total ve difference dosyada belli.

Şunu yapmak istiyorum. Mesela 22.4 den 31.5 e kadar olan tarihlerde bu 4 veriyi 4 ayrı sütunda alt alta yazmasını istiyorum, tabii tarih sırasına göre.

Birde bunun gibi 10 ayrı dosya var aynı formatta. O dosyalar için de aynı formülü uygulamak istiyorum.
Şimdiden teşekkürler, selamlar..

 

[Emir Hüseyin Çoban]

. . .

Formülden ziyade makro ile yapmak daha kolay olacaktır.

Bir kaç sayfayı kontrol ettim, veri alınacak hücre adresleri her zaman sabit mi.

. . .

 

[hamza9]

Veri alınacak hücre adresi sabit değil maalesef bazen bir alt satıra veya üst satıra kayabiliyor.
Ama hücrelerden biri referans alınırsa mesela Difference veya computer total diğer hücrelerin konumlaması aynı. yani o hücrenin bir üstü bir altı gibi..

 

[Emir Hüseyin Çoban]

. . .

Tablonuz da yeni bir sayfa ekleyip kodları çalıştırın.

Sub kod()
Application.ScreenUpdating = False

Range("A1") = "Tarih"
Range("B1") = "TOTAL DN."
Range("C1") = "TOTAL USD"
Range("D1") = "COMPUTER TOTAL"
Range("E1") = "DIFFERENCE"

sat = 2
For i = 1 To Sheets.Count
If ActiveSheet.Name <> Sheets(i).Name Then
Set ara = Sheets(i).Range("a:a").Find("DIFFERENCE", , xlValues, xlWhole)

Cells(sat, "A").NumberFormat = "@" '"m/d"
Cells(sat, "A") = Sheets(i).Name
Sheets(i).Cells(ara.Row - 6, "C").Copy
Cells(sat, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets(i).Cells(ara.Row - 4, "C").Copy
Cells(sat, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets(i).Cells(ara.Row - 2, "C").Copy
Cells(sat, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets(i).Cells(ara.Row, "C").Copy
Cells(sat, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
sat = sat + 1

End If
Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "B i t t i "

End Sub

. . .

 

[hamza9]

Çok teşekkür ederim, işimi gördü. Allah razı olsun.

Selamlar.