seri kelimesinden bir önceki

[tahsinanarat]

F sütununda bulunan "000001 port. 0377665 seri no'lu Çek" ibarali cümle içinden ben sadece çek numarası olan 377665 numarasını E sütununa almak istiyorum, (seri kelimesinden önceki boşluğa kadar da diyebiliriz). Bu konuda yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[bzace]

Merhaba,
Verileriniz göremiyorum açıklamalarınıza göre bu işlem için makro gerekli mi?
Formül ile yapmak isterseniz deneyiniz.

=PARÇAAL(YERİNEKOY(A1;" ";YİNELE(" ";38));
  MBUL("seri";YERİNEKOY(A1;" ";
YİNELE(" ";38)))-76;38)

Saygılar,
Hay marja!

 

[tahsinanarat]

Sn. bzace cevabınız için çok teşekkür ederim, yukarıda vurgulamayı unuttum, ben bunu kod ile olmasını istiyorum, ayrıca e sütununda belge numarası varsa ona dokunmayacak, (c sütununda Çek yazıyor ise F sütunundaki çek numarasını E sütununa yazmalı),
Kısacası benim çek numaralarını bir şekilde e sütununa kod ile almam gerekiyor.

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    
    For i = 2 To Cells(Rows.Count, "F").End(3).Row
if  Cells(i, "E")="" then
        If Cells(i, "F") Like "*Çek" Then
            Cells(i, "E") = Split(Cells(i, "F"), " ")(2)
        End If
end if
    Next i
    
End Sub

. . .

 

[tahsinanarat]

Hüseyin hocam çok teşekkür ederim, Elinize sağlık. Pratik bir çözüm oldu.
Bende Şu şekilde halletmiştim ama pek kullanışlı olmayacaktı; j sütununu yardımcı sutun olarak kullanacaktım.

Function trz(adres As String) As String
aa = Split(StrReverse(adres))
trz = StrReverse(aa(3))
End Function

Sub Fyaz()
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Belge No"
    With Range("J2:J" & Cells(Rows.Count, 1).End(3).Row)
        .FormulaR1C1 = "=(IF(RC[-6]=""Çek"",TRZ(RC[-4]),RC[-5]))*1"
        .Value = .Value
    End With
End Sub

 

[tahsinanarat]

Sn. Hüseyin Hocam, F sütununda Çek yazısı aynı zamanda Cek, cek, çek şeklinde olsaydı, kodda nasıl bir değişiklik yapmamız gerekirdi.

 

[Emir Hüseyin Çoban]

. . .

If UCase(Cells(i, "F")) Like "*ÇEK" Or _
   UCase(Cells(i, "F")) Like "*CEK" Then

. . .

 

[tahsinanarat]

Teşekkür ederim hocam, elinize sağlık.

 

[tahsinanarat]

Sn. Hüseyin hocam; D sütununda Çek yazıyorsa sonuca ulaştım, ancak bazen D sütununda çek/senet veya Tahsin çek/senet şeklinde de yazabiliyor, ben çek kelimesi varsa almak istiyordum, biraz parça parça oldu ama kusura bakmayın, orijinal dosyaya uyguladığımda bu anlattıklarımı fark ettim.

Sub saticicekleri()
    
    Sub saticicekleri()
    
    For i = 2 To Cells(Rows.Count, "F").End(3).Row
   If Cells(i, "d") = "Çek" Then
   If UCase(Cells(i, "F")) Like "*ÇEK" Or _
   UCase(Cells(i, "F")) Like "*CEK" Then
            Cells(i, "E") = Split(Cells(i, "F"), " ")(2)
        End If
End If
    Next i
    
End Sub

 

[Emir Hüseyin Çoban]

. . .

    For i = 2 To Cells(Rows.Count, "F").End(3).Row
        
       [COLOR="DarkRed"] If UCase(Cells(i, "d")) Like "*ÇEK*" Or _
            UCase(Cells(i, "d")) Like "*SENET*" Then[/COLOR]
            If UCase(Cells(i, "F")) Like "*ÇEK" Or _
                UCase(Cells(i, "F")) Like "*CEK" Then
                Cells(i, "E") = Split(Cells(i, "F"), " ")(2)
            End If
        End If
    Next i    For i = 2 To Cells(Rows.Count, "F").End(3).Row

. . .

 

[tahsinanarat]

Hüseyin hocam şimdi mükemmel oldu, hakkınızı helal edin, elinize kolunuza sağlık.

 

[Korhan Ayhan]

Alternatif,

INSTR komutunu da kullanabilirsiniz.

Sub Makro()
    Dim X As Long, Veri As Variant, Y As Integer

    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = 2 To Son
        If InStr(1, UCase(Cells(X, "F")), "ÇEK") > 0 Or InStr(1, UCase(Cells(X, "F")), "CEK") > 0 Then
            If Cells(X, "E") = "" Then
                Veri = Split(UCase(Replace(Replace(Cells(X, "F"), "ı", "I"), "i", "İ")), " ")
                For Y = 0 To UBound(Veri)
                    If InStr(1, Veri(Y), "SERİ") > 0 Then
                        Cells(X, "E").NumberFormat = "@"
                        Cells(X, "E") = CStr(Veri(Y - 1))
                        Exit For
                    End If
                Next
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Korhan hocam uygulamada hata veriyor, dosya üzerinde uyarlanmış halini gönderebilir misiniz.

 

[Korhan Ayhan]

Tahsin Bey,

Sizin ilk mesajınızdaki dosyada denedim ve olumlu sonuç aldım.

 

[tahsinanarat]

Korhan hocam, bende aynı dosyada deniyorum, ekte gönderildiği şekilde hata alıyorum.
Not: evdeki bilgisayarımda da denedim, sonuç alamıyorum.

 

[Korhan Ayhan]

Tahsin Bey,

Üstteki mesajımda ki kodda küçük bir düzeltme yaptım. Tekrar dener misiniz?

 

[tahsinanarat]

Korhan Hocam şimdi denetim, mükemmel oldu, ilgi ve alakanıza çok teşekkür ediyorum, Hüseyin Hocama'da çok çok teşekkürler. Saygılar