çek takip

[Bintang]

Merhaba Çek Takip Tablosu yapmak istiyorum ama bir türlü beceremedim. Acaba bu konuda yardımcı olurmusunuz rica etsem.

 

[Ömer BARAN]

Merhabalar.
Çek no sütununa bilgileriniz hazır geliyorsa basit bir eğersay formülüyle sonucu 1 olanlar "PORTFÖYDE", 2 olanlar "TAHSİL EDİLDİ" şeklinde sonuç verecek aşağıdaki gibi bir formül yazılabilir.

=EĞER(EĞERSAY($G$4:$G$79;$G4)=1;"PORTFÖYDE";EĞER(EĞERSAY($G$4:$G$79;$G4)=2;"TAHSİL EDİLDİ";""))

 

[Bintang]

Üstadım ilk önce cevabınız için teşekkür ederim. Maalesef ki Çek No sütununa çek numaraları hazır gelmiyor ben onları Metni Sütunlara Dönüştür den ayırıp kopyala yapıştır ile yapıyorum.

 

[Ömer BARAN]

Estağfurullah, önemli olan ihtiyacın görülmesi.

O zaman kaynağından gelen verinin formatını bilseydik ben veya başkası mutlaka çözüm üretirdi.

Şayet orijinal veri D sütunundaki ise o da formüle edilebilir.

 

[Bintang]

Üstadım günaydın. Orijinal veri D sütunundaki gibi gelmektedir. Ben bu sütundaki verileri Netsis adlı paket programdan kopyalayıp excel e yapıştırarak yapıyorum.

 

[Ömer BARAN]

Merhaba Module1'deki kod kısmını aşağıdaki ile değiştiriniz.
"Çek No" sütunu ile "Durumu" sütununundaki verileri sildikten sonra A, B, C ve D sütunlarına
yeni veriler yazıp SIRALAMA DÜĞMELERİNİ kullanarak test ediniz.
Böylece sayfanızda formül kullanmadan sonuç almış olmanız lazım.

Sub Çek_No_Sırala()
Dim son As Integer
son = Sheets("101-01-01").Range("A65536").End(3).Row
Application.ScreenUpdating = False
    
    Range("A4:H4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A4:H" & son).Select
    ActiveWorkbook.Worksheets("101-01-01").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("101-01-01").Sort.SortFields.Add Key:=Range( _
        "G4:G989"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("101-01-01").Sort
        .SetRange Range("A4:H" & son)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With Range("G4:G" & son) ' G Sütunu
    .Formula = "=RIGHT(LEFT(D4,FIND("" "",D4,1)-1),6)"
    .Value = .Value
End With

With Range("H4:H" & son) ' H Sütunu
    .Formula = "=IF(COUNTIF($G$4:$G$79,$G4)=1,""PORTFÖYDE"",IF(COUNTIF($G$4:$G$79,$G4)=2,""TAHSİL EDİLDİ"",""""))"
    .Value = .Value
End With
Range("A3").Activate
Application.ScreenUpdating = True
End Sub

Sub Tarih_Sırası()
Dim son As Integer
son = Sheets("101-01-01").Range("A65536").End(3).Row
Application.ScreenUpdating = False
    
    ActiveWorkbook.Worksheets("101-01-01").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("101-01-01").Sort.SortFields.Add Key:=Range( _
        "A4:A" & son), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("101-01-01").Sort.SortFields.Add Key:=Range( _
        "B4:B" & son), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("101-01-01").Sort
        .SetRange Range("A4:H" & son)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

With Range("G4:G" & son) ' G Sütunu
    .Formula = "=RIGHT(LEFT(D4,FIND("" "",D4,1)-1),6)"
    .Value = .Value
End With

With Range("H4:H" & son) ' H Sütunu
    .Formula = "=IF(COUNTIF($G$4:$G$79,$G4)=1,""PORTFÖYDE"",IF(COUNTIF($G$4:$G$79,$G4)=2,""TAHSİL EDİLDİ"",""""))"
    .Value = .Value
End With

Range("A3").Activate
Application.ScreenUpdating = True
End Sub

 

[Ömer BARAN]

Merhaba, kodların uygulanmış olduğu belge ekte.

İnceleyiniz, test ediniz.

 

[Bintang]

Merhaba, kodların uygulanmış olduğu belge ekte.

İnceleyiniz, test ediniz.

Üstadım ellerinize sağlık gerçekten çok güzel olmuş ellerinize sağlık tekrar, tekrar teşekkür ederim. Gönderdiğiniz programı sizinde dediğiniz gibi test ettim ufak bir hata oldu bunu ekte de size gönderiyorum.

 

[Ömer BARAN]

Merhaba.
Belge açıkken ALT+F11 tuşlarına bastığğınızda VBA ekranı açılır.
Sol taraftan Modüle 1'e çift tıklayın sağ tarafta (iki kriter için birer kez olmak üzere) aşağıdaki satırı;

    .Formula = "=RIGHT(LEFT(D4,FIND("" "",D4,1)-1),6)"

aşağıdaki ile değiştirin.

    .Formula = "=MID(D4,FIND(""/"",D4,1)+9,6)"

İki yerde olduğunu unutmayın değişikliği ikisi için de yapın.

 

[Bintang]

Üstadım çok teşekkür ederim. Ellerinize sağlık yardımlarınız için çok teşekkür ederim.

 

[Bintang]

Üstadım merhaba sizden bir ricam daha olacak açıklamada ki vade tarihini de aynen çek no da olduğu gibi ayırmak istiyorum. Bu konuda yardımcı olabilirmisiniz

 

[ÆSir]

With Range("H4:H" & son) ' H Sütunu
.Formula = "=IF(COUNTIF($G$4:$G$79,$G4)=1,""PORTFÖYDE"",IF(COUNTIF($G$4:$G$79,$G4)=2,""TAHSİLDE"",""""))"
.Value = .Value
End With


Burada portföy veya tahsili otomatik çekmesi gerekmiyor mu? Veya 1-2 ile?