Soru Muhasebe kodu bulma

[NADİR YILDIZ]

Arkadaşlar sorunumu örnek dosyamda anlattım.yardım edecek arkadaşlara şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Arama işleminde ilk önce birebir kısa ünvanlar içerir mantığı ile aranıyor. Eşleşme varsa kod listeye yazdırılıyor.

Eğer eşleşme yoksa bu sefer kısa ünvanlar kelime bazında parçalanıp arama işlemi yapılıyor. Sıkıntı burada başlıyor.

Çünkü G17 hücresinde NADİR YILDIZ yazıyor. C26 hücresinde ise GÖNDEREN ZEKİ YILDIZ yazıyor. Arama kelime bazında yapıldığı için ve YILDIZ kelimeleri eşleştiği için sorun oluşuyor.

Yani kelime bazlı aramayı iptal etmeniz daha sağlıklı gibi görünüyor.

 

[NADİR YILDIZ]

Korhan bey teşekkür ederim.
dediğiniz anladım.arama yaparken YILDIZ değilde nadir yıldız yada zeki yıldız olarak arama yapılabilir mi ?

ikincisi hesap kodunu bulamadığında H1 hücresindeki 800.01 hesap kodunu atabilir mi ?

 

[Korhan Ayhan]

Bu şekilde deneyiniz.

Option Explicit

Sub Muhasebe_Kodu_Bul()
    Dim S1 As Worksheet, Liste As Variant, Veri As Variant
    Dim Y As Long, Son_C As Long, Son_G As Long, X As Long
    Dim Kelime As Variant, Z As Integer, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("MUHASEBE")
    
    S1.Range("D5:D" & S1.Rows.Count).ClearContents
    S1.Range("D5:D" & S1.Rows.Count).NumberFormat = "@"
    
    Son_C = S1.Cells(S1.Rows.Count, 3).End(3).Row
    Veri = S1.Range("C5:D" & Son_C).Value2
    
    Son_G = S1.Cells(S1.Rows.Count, 7).End(3).Row
    Liste = S1.Range("G5:H" & Son_G).Value2
    
    For X = LBound(Veri) To UBound(Veri)
        For Y = LBound(Liste) To UBound(Liste)
            If InStr(1, UCase(Replace(Replace(Trim(Veri(X, 1)), "ı", "I"), "i", "İ")), UCase(Replace(Replace(Trim(Liste(Y, 1)), "ı", "I"), "i", "İ"))) > 0 Then
                Veri(X, 2) = Liste(Y, 2)
            End If
        Next
    
        If Veri(X, 2) = Empty Then Veri(X, 2) = S1.Range("H1")
    Next
    
    S1.Range("C5").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri
    S1.Range("D:D").Replace What:=",", Replacement:=".", LookAt:=xlPart

    Set S1 = Nothing

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[NADİR YILDIZ]

Üstat teşekkür ederim.emeğinize aklınıza sağlık

iyi çalışmalar dilerim