Hücredeki Veriyi Ayırma

[iplikci_80]

Yapmak istediğim şey bir hücreye TR530009900625203100100002 şeklinde girdiğim verinin kendiliğinden TR53 0009 9006 2520 3100 1000 02 şekline dönüşmesini sağlamak. Bu konuda yardımlarınız bekliyorum.

 

[ÖmerBey]

Makro ile yapmak isterseniz aşağıdaki kodu işlem yaptığınız sayfanın kod kısmına kopyalayınız.
Hücreye TR ile başlayan 26 karakterli bir değer girdiğiniz zaman otomatik olarak değiştirir.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim değer(6)
If Len(Target) = 26 And Left(Target, 2) = "TR" Then
    For a = 1 To 26 Step 4
        değer(b) = Mid(Target, a, 4)
        b = b + 1
    Next
    Target = Join(değer, " ")
End If
End Sub

 

[iplikci_80]

Sayın mucit77 öncelikle ilginiz çok teşekkür ederim. Bu kodu EK 'te gönderdiğim çalışmaya uygulayabilir miyiz lütfen.

 

[ÖmerBey]

Siz uygulamışsınız zaten.
Yüklediğiniz dosyadaki hücrelere girip enter tuşuyla çıktıktan sonra kodların çalıştığını göreceksiniz.

 

[iplikci_80]

Merhabalar Mucit 77; kodları EK 'te gönderdiğim örneğin P sütununa göre uygulamaya çalıştım ama bir türlü başaramadım. Rica etsem bu hususta yardım edebilir misiniz.

 

[ÖmerBey]

Merhaba, öncelikle şunu sorayım o halde. Bu veriler zaten girilmiş veriler ve siz onları topluca değiştirmeyi mi düşünüyorsunuz, yoksa daha sonra tek tek gireceksiniz de istediğiniz formatta olsun diye mi kod istiyorsunuz.

 

[iplikci_80]

Hem topluca değiştireceğim ve daha sonra girdiğim veriler bu formatta olsun istiyorum.

 

[ÖmerBey]

O halde Veri tabanı sayfasının Worksheet_Change olayına aşağıdaki ilaveyi yapınız.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

[COLOR="Red"]If Not Intersect(Target, Range("P:P")) Is Nothing And Target.Cells.Count = 1 Then
    Dim değer(6)
    If Len(Target) = 26 And Left(Target, 2) = "TR" Then
        For a = 1 To 26 Step 4
            değer(b) = Mid(Target, a, 4)
            b = b + 1
        Next
        Target = Join(değer, " ")
    End If
End If[/COLOR]

     
If (Intersect(Target, Range("G5:G65536")) Is Nothing) Or Hedef_Satir = Target.Row Then
    Hedef_Satir = 0
    Exit Sub
End If

Hedef_Satir = Target.Row
Kayit_Sil (Hedef_Satir)
Application.ScreenUpdating = True

End Sub

Topluca değiştirmek için de aşağıdaki kodu boş bir modüle kopyalayıp deneyiniz.

Sub Kod()
Set vt = Sheets("VERİ TABANI")
For Each hücre In Range(vt.Cells(5, "P"), vt.Range("P65500").End(3))
    Dim değer(6)
    If Len(hücre.Value) = 26 And Left(hücre.Value, 2) = "TR" Then
        For a = 1 To 26 Step 4
            değer(b) = Mid(hücre.Value, a, 4)
            b = b + 1
        Next
        hücre.Value = Join(değer, " ")
    End If
    b = 0
Next
End Sub

 

[iplikci_80]

Sayın Mucit77 gönderdiğiniz kodları denedim fakat hata veriyor, bun ilişkin son çalışmam EK 'te dir. Muhtemelen ben bir hata yapıyorumdur. Bir kontrol edebilir misiniz lütfen.

 

[iplikci_80]

Sayın mucit77 sorun çözülmüştür. Ayırdığınız zaman ve harcadığınız emek için çok teşekkür ederim.