RegExp / Farklı Formatlardaki Plakalar için tek fonksiyon

[walabi]

Merhaba,

Farklı formatlarda , yani veri girişi olarak formatları farklı plakalar mevcut. Aşağıda görünen 3 KTF bende çalışan ve işime yarayan fonksiyonlar. Bunları tek bir fonksiyon haline getirmem mümkün mü? Yani fonksiyona şunu diyebilir miyim!!! Bu formatın sonucu boş ise şu formatı dene gibi.


Bu standart plaka formatı

Function Plaka_1(hcr As Range) As String
    Dim reg As Object, m As Object
  
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then Plaka_1 = m(0)
End Function

Aşağıdakiler farklılık arzeden plaka formatları için

Örneğin 34 00 55 66666 gibi bir plaka olabiliyor ve aralara boşluk yerine - (tire) işareti ya da . (nokta) kullanılabiliyor.
34 00 55 66666
34-00-55-66666
34.00.55.66666

gibi gibi,

Function Plaka_2(hcr As Range) As String
    Dim reg As Object, m As Object
  
    Set reg = CreateObject("VBScript.RegExp")
    'reg.Pattern = "\b\d{2}\S?[A-Za-z0-9]{1,3}\S?\d{2,5}\b"
    reg.Pattern = "\b\d{2}\S?\b\d{2}\S?\b\d{2}\S?\d{2,5}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then Plaka_2 = m(0)
End Function

Ayrıca bazı plakalar ( iş makinaları plakaları gibi ), içinde harf içerirken, bazıları sayı içeriyor, aşağıdaki örneğin standart olarak tek harf içermekte.

Function Plaka_3(hcr As Range) As String
    Dim reg As Object, m As Object
  
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "\b\d{2} \s?[A-Za-z]{1,1}\s?\d{2,5}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then Plaka_3 = m(0)
End Function

 

[muhasebeciyiz]

Evet, farklı plaka formatlarını tek bir fonksiyon içinde birleştirebilirsiniz. Bu fonksiyon, sırayla farklı formatları deneyerek, ilk eşleşen formatı döndürebilir

Function Plaka(hcr As Range) As String
    Dim reg As Object, m As Object
    Dim patterns As Variant
    Dim i As Integer   
    
    patterns = Array( _
        "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b", _  ' Plaka_1 formatı
        "\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b", _  ' Plaka_2 formatı
        "\b\d{2} \s?[A-Za-z]{1,1}\s?\d{2,5}\b"    ' Plaka_3 formatı
    )
    
    Set reg = CreateObject("VBScript.RegExp")   
    
    For i = LBound(patterns) To UBound(patterns)
        reg.Pattern = patterns(i)
        Set m = reg.Execute(hcr.Value)
        If m.Count > 0 Then
            Plaka = m(0)
            Exit Function
        End If
    Next i       
    Plaka = ""
End Function

Bu fonksiyonu kullanırken, Plaka fonksiyonunu çağırarak farklı formatlardaki plakaları tek bir fonksiyonla kontrol edebilirsiniz

Sub TestPlaka()
    Dim plaka1 As String
    Dim plaka2 As String
    Dim plaka3 As String
    
    plaka1 = Plaka(Range("A1")) 
    plaka2 = Plaka(Range("A2")) 
    plaka3 = Plaka(Range("A3"))
    
    MsgBox "Plaka 1: " & plaka1 & vbCrLf & _
           "Plaka 2: " & plaka2 & vbCrLf & _
           "Plaka 3: " & plaka3
End Sub

 

[walabi]

Teşekkürler.

 

[muhasebeciyiz]

Kırmızı renkte görünen hata, muhtemelen sözdizimi (syntax) hatası veya eksik/yanlış karakter kullanımı nedeniyle oluşmuştur.

Function Plaka(hcr As Range) As String
    Dim reg As Object, m As Object
    Dim patterns As Variant
    Dim i As Integer  
   
    patterns = Array( _
        "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b", _
        "\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b", _
        "\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b"    
    )
   
    Set reg = CreateObject("VBScript.RegExp")  
   
    For i = LBound(patterns) To UBound(patterns)
        reg.Pattern = patterns(i)
        Set m = reg.Execute(hcr.Value)
        If m.Count > 0 Then
            Plaka = m(0)
            Exit Function
        End If
    Next i      
    Plaka = ""
End Function

Denermisiniz.Hala kırmızı renkte hata görüyorsanız, VBA'da debug kullanarak hatanın tam yerini bulabilirsiniz

 

[walabi]

Kırmızı renkte görünen hata, muhtemelen sözdizimi (syntax) hatası veya eksik/yanlış karakter kullanımı nedeniyle oluşmuştur.

Function Plaka(hcr As Range) As String
    Dim reg As Object, m As Object
    Dim patterns As Variant
    Dim i As Integer 
  
    patterns = Array( _
        "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b", _
        "\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b", _
        "\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b"   
    )
  
    Set reg = CreateObject("VBScript.RegExp") 
  
    For i = LBound(patterns) To UBound(patterns)
        reg.Pattern = patterns(i)
        Set m = reg.Execute(hcr.Value)
        If m.Count > 0 Then
            Plaka = m(0)
            Exit Function
        End If
    Next i     
    Plaka = ""
End Function

Denermisiniz.Hala kırmızı renkte hata görüyorsanız, VBA'da debug kullanarak hatanın tam yerini bulabilirsiniz

şu şekilde yaptığımda problem çözülüyor, bende sonradan farkettim. Alt tire eksikti.

        "\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b")

 

[walabi]

Çalışan hali bu şekilde,

Function Plaka(hcr As Range) As String
    Dim reg As Object, m As Object
    Dim patterns As Variant
    Dim i As Integer
  
    patterns = Array( _
        "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b", _
        "\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b", _
        "\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b" _
        )
  
    Set reg = CreateObject("VBScript.RegExp")
  
    For i = LBound(patterns) To UBound(patterns)
        reg.Pattern = patterns(i)
        Set m = reg.Execute(hcr.Value)
        If m.Count > 0 Then
            Plaka = m(0)
            Exit Function
        End If
    Next i
    Plaka = ""
End Function

 

[muhasebeciyiz]

Evet, VBA'da _ (alt çizgi) karakteri, bir satırın devam ettiğini belirtmek için kullanılır. Ancak, bu karakterin doğru kullanıldığından emin olmak önemlidir. _ karakteri, yalnızca satır sonunda ve bir boşlukla ayrılmış şekilde kullanılmalıdır. Aksi takdirde VBA derleyicisi hata verecektir.

Eğer _ karakteri kullanmak istemiyorsanız, tüm pattern'leri tek bir satıra yazabilirsiniz.
patterns = Array("\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b", "\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b", "\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b")

örnek sonuç şu şekilde olacaktır.

"\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b": İlk plaka formatı (örneğin, 34 ABC 123).
"\b\d{2}\S?\d{2}\S?\d{2}\S?\d{2,5}\b": İkinci plaka formatı (örneğin, 34-00-55-66666).
"\b\d{2} \s?[A-Za-z]{1}\s?\d{2,5}\b": Üçüncü plaka formatı (örneğin, 34 A 12345).

 

[walabi]

Teşekkürler cevaplar için.

 

[walabi]

Merhaba, farklı bir konu açmak istemediğim için konu devamı olarak sormak istedim.

Aşağıda görünen fonksiyon ile "METİN 34 AA 3434 METİN" şeklindeki bir metinden plakayı ayırabiliyorum. Ancak "METİN34 AA 3434 METİN" gibi bir veri olduğunda fonksiyon bunu ayırmıyor. Plakanın ilk sayı karakterinden önce gelen ve son sayı karakterinden sonra gelen herhangi bir Harf, Boşluk karakteri, * yıldız karakteri, . nokta karakteri gibi karakterler geldiğinde plakayı ayırmak için aşağıdaki satır nasıl olmalı??

Function ExtractPlaka(hcr As Range) As String
    Dim reg As Object, m As Object
   
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then ExtractPlaka = m(0)
End Function

 

[Korhan Ayhan]

Merhaba,

Desen konusunda çok iyi değilim ama aşağıdaki desen sonuç veriyor gibi görünüyor.

(\d{2}[a-zA-Z-+*._\/ ]*\d{,6})

 

[walabi]

Korhan bey , sizin yazdığınız kodun vbaya uyarlanışı aşağıdaki gibi olacaksa sonuç alamadım, ben kodlarda hata yapmıyorsam. Yazdığınız satır sanırım çift tırnak içine alınarak kullanmak gerekiyor. Sadece çift tırnak içine ekleme yaptım.

Function Test_Format4(hcr As Range) As String
    Dim reg As Object, m As Object
 
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "(\d{2}[a-zA-Z-+*._\/ ]*\d{,6})"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then Test_Format4 = m(0)
End Function

 

[halily]

reg.Pattern = "\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b" kodunu dener misiniz?
yanılmıyorsam \b kelimenin içinde geçmemesi bağımsız kelime olması için kullanılıyor

 

[walabi]

@haliliyas haklısınız, \b baştaki ve sondaki bu ifadeyi kaldırınca istediğim gibi veriyi ayırıyor. Ben tam tersi bir işlev yaptığını düşünmüştüm bu ifadenin.

 

[halily]

Rica ederim
İyi çalışmalar

 

[Korhan Ayhan]

Sorun çözülmüş...

Ben aşağıdaki sitede denedim.. Sorun görünmeyince paylaştım. Demek ki excel için uyumlu olmamış...