Yazı dizisinde Araç Plakasını ayırmak...

[Erhan Yavuz]

Araç plakalarının yazım düzenin de yazılması için aşağıdaki kod bloğu kullanılır...

Kod: [Seç]

Function plakaAyir(Plaka As String)
    Plaka = Replace(UCase(Plaka), " ", "")
    With CreateObject("vbscript.regexp")
        .Pattern = "([0-9]{2})([A-Z]{1,3})([0-9]{2,4})"
        .Global = True
        plakaAyir = .Replace(Plaka, "$1 $2 $3")
       
    End With
End Function
Benim sormak istediğim örneğin bir yazı dizisi içinden bu plaka bloğunu çekip alabilirmiyiz..??

Örneğin:

FT NO: 122 KON PETROL  34 COG 85 YAKIT ALIMI KDVSI

satırındaki 34 COG 85 silmek istesek...

veya;

FT NO: 74 34 R 3678 MAZOT ALIMI KDVSI

Satırındaki;

34 R 3678 plaka bloğunu silebilirmiyiz?

veya;

34 ER 544 PLK ARÇ KIRASI ORHAN ÜLKER EKIM/09

Satırındaki 34 ER 544 plaka bloğunu silelim...

[Bülent Öztürk]

Erhan abi, şöyle bir çözüm olabilir sanırım;

Kod: [Seç]

Sub Excelce_Plaka_Sil()
On Error Resume Next
bosluklar = Split(ActiveCell.Value, " ", , vbBinaryCompare)
For excelce = 0 To UBound(bosluklar)
If IsNumeric(bosluklar(excelce - 2)) And IsNumeric(bosluklar(excelce)) And Not IsNumeric(bosluklar(excelce - 1)) Then
    Plaka = (bosluklar(excelce - 2)) & " " & (bosluklar(excelce - 1)) & " " & (bosluklar(excelce)) & " "
ActiveCell.Value = VBA.Replace(ActiveCell, Plaka, "")
End If
Next excelce
End Sub
KTF yapmadım, dilersen dönüştürürüz.
Kolay gelsin.

[Erhan Yavuz]

Canım kardeşim, sen nerelerdesin, özlettin kendini, tatilde nerelere kaçtın... Yazında bile olsa yanımızda olman ne güzel.

Bu arada site açılınca -NOD32  "crlnject.B.Gen.Virus" uyarısı yapıyor nedendir?

[Erhan Yavuz]

FİŞ NO:3 KAYALAR PETROL 34 GK 4390

İlginçtir yukarıdaki dizgide tespit edemiyor?

[Bülent Öztürk]

Canım kardeşim, sen nerelerdesin, özlettin kendini, tatilde nerelere kaçtın... Yazında bile olsa yanımızda olman ne güzel.

Tatilde evdeyim, tadilat yapacağız. Usta araştırıyorum, fiyat araştırıyorum...

Bu arada site açılınca -NOD32  "crlnject.B.Gen.Virus" uyarısı yapıyor nedendir?

Site anasayfaya frame atılıyor. Direkt foruma girdiğim için de geç fark ediyorum.
Forumda uyarı olmaması lazım.

[Bülent Öztürk]

FİŞ NO:3 KAYALAR PETROL 34 GK 4390

İlginçtir yukarıdaki dizgide tespit edemiyor?

Şöyle dener misin?

Kod: [Seç]

Sub Excelce_Plaka_Sil()
On Error Resume Next
bosluklar = Split(ActiveCell.Value, " ", , vbBinaryCompare)
For excelce = 0 To UBound(bosluklar)
If IsNumeric(bosluklar(excelce - 2)) And IsNumeric(bosluklar(excelce)) And Not IsNumeric(bosluklar(excelce - 1)) Then
    Plaka = (bosluklar(excelce - 2)) & " " & (bosluklar(excelce - 1)) & " " & (bosluklar(excelce))
ActiveCell.Value = VBA.Replace(ActiveCell, Plaka, "")
End If
Next excelce
End Sub

[Erhan Yavuz]

Çok teşekkürler değerli dost... Çok işime yarayacak..

Bu arada örnek olması açısından Tarkan Vural kardeşimin örneğini de sizlerle paylaşayım, örnek örnektir...

Kod: [Seç]

Option Base 1
Function plaka(veri As String) As String
Dim evn As Variant
Application.Volatile
evn = Split(Trim(veri), " ")
For i = LBound(evn) To UBound(evn)
    If IsNumeric(evn(i)) Then
        If Not IsNumeric(evn(i + 1)) Then
            If IsNumeric(evn(i + 2)) Then
                If Len(evn(i)) = 2 And CLng(evn(i)) > 0 And CLng(evn(i)) < 82 Then
                    If Len(evn(i + 1)) < 4 Then
                        If Len(evn(i + 2)) > 0 And Len(evn(i)) <= 4 And CLng(evn(i)) > 0 Then
                            For a = LBound(evn) To UBound(evn)
                                If a <> i And a <> i + 1 And a <> i + 2 Then
                                    plaka = plaka & evn(a) & " "
                                End If
                            Next a
                            Exit Function
                        End If
                    End If
                End If
            End If
        End If
    End If
Next i
End Function

[Bülent Öztürk]

Sağol Erhan abi.