Plaka Ayırma

[Seyit Tiken]

Arkadaşlar Herkese Selamlar,
Herhangi bir hücreye yazılan, örneğin : 35AN475 nolu araba plakasını 35 AN 475 olarak, yani boşluk bırakacak bir makro lazım. Şimdiden teşekkür ediyorum.

 

[uzmanamele]

merhaba

http://www.excel.web.tr/showthread.php?t=39225

 

[Seyit Tiken]

Teşekkür ediyorum Uzmanamele. Gösterdiğiniz Link fonksiyonla ilgiliydi. Bana kod lazım. Yani aynı hücrede yazılıp enterlendiğinden ayırma işlemini yapacak. İlginiz için teşekkürler.

 

[uzmanamele]

merhaba
syn Seyit Tiken, aşağıdaki linkde bir çok kod var, aradığınız kodu belki burada bulabilirsiniz.

http://www.alpc.net/vb6/

 

[N.Ziya Hiçdurmaz]

Yanıt

Bu şekil deneyiniz

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target = Mid(Target, 1, 2) & " " & Mid(Target, 3, 2) & " " & Mid(Target, 5, 3)
Application.EnableEvents = True
End Sub

 

[uzmanamele]

merhaba
syn N.Ziya Hiçdurmaz 2-2-3 şeklinde gruplandırmak 34T2345 gibi plakalarda sorun çıkartır.

 

[Seyit Tiken]

Ziya bey teşekkür ediyorum. Standart bir plaka için güzel çalışıyor kod. Sayın Uzmanamele'nin belirtiği gibi farklı krakter girildiğinde aynı çözümü sunmuyor. Koda nasıl bir ekleme yapılabilir.

 

[Orion1]

Ziya bey teşekkür ediyorum. Standart bir plaka için güzel çalışıyor kod. Sayın Uzmanamele'nin belirtiği gibi farklı krakter girildiğinde aynı çözümü sunmuyor. Koda nasıl bir ekleme yapılabilir.

Seyit bey aşağıdaki kodu hazırladım.
Hatasız gibi görünüyor.
A sütunundaki değerleri b sütununa yazdırıyor.
İyi çalışmalar .

Sub plaka()
For i = 1 To Cells(65536, "A").End(xlUp).Row
    If Cells(i, "A").Value = "" Then GoTo atla
    For k = 1 To Len(Cells(i, "A").Value)
        If Not IsNumeric(Mid(Cells(i, "A").Value, k, 1)) Then
            ilk = k - 1
            GoTo son
        End If
    Next k
son:
    For k = ilk + 1 To Len(Cells(i, "A").Value)
        If Not IsNumeric(Mid(Cells(i, "A").Value, k, 1)) Then
            orta = k
        End If
    Next k
    For k = 1 To ilk
        deg = deg & Mid(Cells(i, "A").Value, k, 1)
    Next
    deg = deg & " "
    For k = ilk + 1 To orta
        deg = deg & Mid(Cells(i, "A").Value, k, 1)
    Next
    deg = deg & " "
    For k = orta + 1 To Len(Cells(i, "A").Value)
        deg = deg & Mid(Cells(i, "A").Value, k, 1)
    Next
Cells(i, "B").Value = deg
deg = ""
atla:
Next
End Sub

 

[uzmanamele]

merhaba
girilen değerin 4. karakteri sayıysa
Mid(Target, 1, 2) & " " & Mid(Target, 3, 1) & " " & Mid(Target, 4, 4)
değilse
Mid(Target, 1, 2) & " " & Mid(Target, 3, 2) & " " & Mid(Target, 5, 3)
gibi if komutu kullanılabilir

 

[Orion1]

merhaba
girilen değerin 4. karakteri sayıysa
Mid(Target, 1, 2) & " " & Mid(Target, 3, 1) & " " & Mid(Target, 4, 4)
değilse
Mid(Target, 1, 2) & " " & Mid(Target, 3, 2) & " " & Mid(Target, 5, 3)
gibi if komutu kullanılabilir

Merhaba.
8 numaralı cevabıma baktınızmı?

 

[uzmanamele]

merhaba
syn Evren Gizlen, sizin cevabı görmeden cevap vermiştim, sizin kodlara itirazım yok. elinize sağlık.

 

[Necdet]

Merhaba,

Benim de çalışmam boşa gitmesin.

Sub Plaka()
For i = 1 To [A65536].End(3).Row
    For j = 1 To Len(Cells(i, "A"))
        If IsNumeric(Mid(Cells(i, "A"), j, 1)) = False Then
            Bas = j
            Exit For
        End If
    Next j
    For j = j + 1 To Len(Cells(i, "A"))
        If IsNumeric(Mid(Cells(i, "A"), j, 1)) = True Then
            Bit = j
            Exit For
        End If
    Next j
                   
    Cells(i, "B") = Trim(Left(Cells(i, "A"), Bas - 1)) & " " & _
                    Trim(Mid(Cells(i, "A"), Bas, Bit - Bas)) & " " & _
                    Trim(Right(Cells(i, "A"), Len(Cells(i, "A")) - Bit + 1))
Next i
End Sub

 

[Seyit Tiken]

Arkadaşlar kodlar süper. Hemen arşive attım. Teşekkür ediyorum.

 

[Orion1]

Arkadaşlar kodlar süper. Hemen arşive attım. Teşekkür ediyorum.

Rica ederim.
İyi günlerde kullanın.
Aşağıdaki ekli dosyada ve yazdığım KTF var.Belki fonksiyon olarakta kullanabilrsiniz.
Kullanımı:

=plaka(A1)

Function plaka(deger As Range)
    If deger = "" Then GoTo atla
    For k = 1 To Len(deger)
        If Not IsNumeric(Mid(deger, k, 1)) Then
            ilk = k - 1
            GoTo son
        End If
    Next k
son:
    For k = ilk + 1 To Len(deger)
        If Not IsNumeric(Mid(deger, k, 1)) Then
            orta = k
        End If
    Next k
    For k = 1 To ilk
        deg = deg & Mid(deger, k, 1)
    Next
    deg = deg & " "
    For k = ilk + 1 To orta
        deg = deg & Mid(deger, k, 1)
    Next
    deg = deg & " "
    For k = orta + 1 To Len(deger)
        deg = deg & Mid(deger, k, 1)
    Next
plaka = deg
atla:
End Function

 

[Seyit Tiken]

Evren Bey, teşekkür ediyoruz, saygılar.

 

[Orion1]

Evren Bey, teşekkür ediyoruz, saygılar.

Rica ederim.Seyit bey,
Saygılar benden.