Tarih hesaplamalı format değişimi hk.

[Hamington]

Arkadaşlar,

Çok arama yaptım, çok inceledim ancak aşağıda tanımladığım şeyleri başarabilecek bilgilere ulaşamadım.

Olabildiğince açık özetlemeye çalıştım. Umarım anlaşılabilir olmuştur. Yardımlarınızı rica ederim.


Yapılmak İstenenler:

1. Draft Dosyasında A3 hücresinin ilk 14 karakterini alıp , Yeni dosyasındaki A2 hücresine yazsın,

2. Draft Dosyasında A3 hücresinin 18. karakterden sonraki karakterlerin tamamını (kaç tane varsa) Yeni dosyasındaki B2 hücresine yazsın.

3. Draft dosyasında C3 deki tarihi Yeni dosyasında E2 hücresinde göstersin.

4. Draft Dosyasında C3 hücresindeki tarihi dikkate alsın. O tarihten bugünkü tarihe kadar kaç takvim günü geçtiğini hesaplasın ve;

Eğer; 0-30 takvim günü geçmişse Yeni dosyasında G2 hücresine Draft Dosyasında H3 hücresindeki rakamı yazsın.​

Eğer; 31-60 takvim günü geçmişse Yeni dosyasında H2 hücresine Draft Dosyasında H3 hücresindeki rakamı yazsın.​

Eğer; 61-90 takvim günü geçmişse Yeni dosyasında I2 hücresine Draft Dosyasında H3 hücresindeki rakamı yazsın.​

Eğer; 90 takvim günü ve fazlası gün geçmişse Yeni dosyasında J2 hücresine Draft Dosyasında H3 hücresindeki rakamı yazsın.​

Eğer; 90 takvim günü ve fazlası gün geçmişse Draft dosyasında C3 hücresindeki tarihten bu güne kaç takvim günü geçtiğini (rakam olarak) yazsın​

5. Yukarıda yazılan işlemleri Draft Dosyasının A sütununda sonraki satırlar için de uygulasın. Ancak alt satırlarda aynı müşteri kaydı ile karşılaşırsa, öncekine toplayarak hesap etsin.

Yani,

Draft dosyasında ÇEBİ TİCARET ' in bakiyelerini incelersek,

Draft_H3 hücresindeki bakiyeyi, Yeni_G2 ye yazmalı zira Draft_C3 teki tarih 0-30 gün arası.​

Draft_H4 ve H5 hücrelerindeki bakiyeleri toplayıp, Yeni_H2 ye yazmalı zira Draft_C3 teki tarih 31-60 gün arası.​

Draft_H6 hücresindeki bakiyeyi, Yeni_I2 ye yazmalı zira Draft_C3 teki tarih 61-90 gün arası.​

Draft_H7 hücresindeki bakiyeyi, Yeni_J2 ye yazmalı zira Draft_C3 teki tarih 91 gün ve üzeri.​

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub veri_çek()
Dim YOL As String, K1 As String, K2 As String
Dim S1 As Worksheet, S2 As Worksheet, SAT As Long
Dim SAT1 As Long, HES As Long
Application.ScreenUpdating = False
YOL = ThisWorkbook.Path & "\"
K1 = "draft.xlsx"
K2 = ActiveWorkbook.Name
Set S1 = ActiveWorkbook.Sheets("Sheet1")
S1.Range("A2:K" & Rows.Count).ClearContents
Workbooks.Open (YOL & K1)
Set S2 = Workbooks(K1).Sheets("Sheet1")
SAT1 = 2
With WorksheetFunction
For SAT = 3 To S2.Range("A" & Rows.Count).End(xlUp).Row
If .CountIf(S2.Range("A3:A" & SAT), S2.Cells(SAT, "A")) = 1 Then
S1.Cells(SAT1, "A") = Mid(S2.Cells(SAT, "A"), 1, 14)
S1.Cells(SAT1, "B") = Mid(S2.Cells(SAT, "A"), 18, _
Len(S2.Cells(SAT, "A")))
S1.Cells(SAT1, "E") = S2.Cells(SAT, "C")
HES = Date - S2.Cells(SAT, "C")
If HES >= 1 And HES <= 30 Then
S1.Cells(SAT1, "G") = S1.Cells(SAT1, "G") + S2.Cells(SAT, "H")
ElseIf HES >= 31 And HES <= 60 Then
S1.Cells(SAT1, "H") = S1.Cells(SAT1, "H") + S2.Cells(SAT, "H")
ElseIf HES >= 61 And HES <= 90 Then
S1.Cells(SAT1, "I") = S1.Cells(SAT1, "I") + S2.Cells(SAT, "H")
ElseIf HES >= 90 Then
S1.Cells(SAT1, "J") = S1.Cells(SAT1, "J") + S2.Cells(SAT, "H")
S1.Cells(SAT1, "K") = HES
End If
SAT1 = SAT1 + 1
Else
HES = Date - S2.Cells(SAT, "C")
If HES >= 1 And HES <= 30 Then
S1.Cells(SAT1 - 1, "G") = S1.Cells(SAT1 - 1, "G") + S2.Cells(SAT, "H")
ElseIf HES >= 31 And HES <= 60 Then
S1.Cells(SAT1 - 1, "H") = S1.Cells(SAT1 - 1, "H") + S2.Cells(SAT, "H")
ElseIf HES >= 61 And HES <= 90 Then
S1.Cells(SAT1 - 1, "I") = S1.Cells(SAT1 - 1, "I") + S2.Cells(SAT, "H")
ElseIf HES >= 90 Then
S1.Cells(SAT1 - 1, "J") = S1.Cells(SAT1 - 1, "J") + S2.Cells(SAT, "H")
S1.Cells(SAT1 - 1, "K") = HES - 90
End If
End If
Next: End With
Workbooks(K1).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation
End Sub

 

[Hamington]

Ellerinize sağlık. Eksik olmayın.

Çalışmanızı uyguamayı denedim ancak başarılı olamadım.

Yeni dosyasında (verileri getirmek istediğim dosyadır) Developer menüsünden Visual Basic modülünü açıyorum.

Yazdığınız scripti Sheet 1 e copyalıyorum.
Kaydederek çıkıyorum.

Ama bu işlemlerle verileri getirmeyi başaramadım.

Bir de buton koyarak yazdığınız kodları butona eklemeyi deneyeceğim..

Nerede yanlış yapıyorum acaba?

 

[Hamington]

Yaptım... Ellerinize sağlık..


Çok teşekkür ederim.
Nasıl bir fayda sağladığınızı anlatamam..

Tekrar tekrar teşekkürler dilerim..

 

[asi_kral]

Yaptım... Ellerinize sağlık..


Çok teşekkür ederim.
Nasıl bir fayda sağladığınızı anlatamam..

Tekrar tekrar teşekkürler dilerim..

Kolay Gelsin.