Soru Özel Karakter Ayırma

leonadies

Excel Derya Deniz Bizde Kulaç Atmaya Çalışıyoruz:)
Altın Üye
Katılım
12 Şubat 2015
Mesajlar
520
Excel Vers. ve Dili
Office 2016 TR 64 Bit Windows
Altın Üyelik Bitiş Tarihi
01-02-2027
Değerli Üstadlar;

A:A sütununda yer alan bu ve aşağıya doğru devamındaki diğer verileri, aralarındaki özel karakterlere göre yandaki B,C,D,E sütunlarına sırasıyla ayırmak istiyorum. Makro ile mümkün mü?

KarakterAyırma.png
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Listenizde hangi özel karakterler var.
 

leonadies

Excel Derya Deniz Bizde Kulaç Atmaya Çalışıyoruz:)
Altın Üye
Katılım
12 Şubat 2015
Mesajlar
520
Excel Vers. ve Dili
Office 2016 TR 64 Bit Windows
Altın Üyelik Bitiş Tarihi
01-02-2027

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Bölünecek verileriniz 100 sütunu geçecekse kod içinde ki aşağıdaki satırda 100 yazan yeri revize ediniz.

ReDim Liste(1 To UBound(Veri, 1), 1 To 100)

C++:
Option Explicit

Sub Verileri_Ozel_Karakterlere_Gore_Sutunlara_Bol()
    Dim Veri As Variant, Son As Long, X As Long
    Dim Metin As String, Kelime As Variant, Y As Integer
   
    Range("B:XFD").Clear
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son < 2 Then Son = 2
   
    Veri = Range("A1:A" & Son).Value
   
    ReDim Liste(1 To UBound(Veri, 1), 1 To 100)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            Metin = Veri(X, 1)
            Metin = Replace(Replace(Replace(Metin, "#", " "), "%", " "), "&", " ")
            Kelime = Split(Metin, " ")
            For Y = LBound(Kelime) To UBound(Kelime)
                Liste(X, Y + 1) = Kelime(Y)
            Next
        End If
    Next

    Range("B1").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Alternatif;

C#:
Sub Test()
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To NoA
        Range("B" & i) = Split(Range("A" & i), "#")(0)
        Range("C" & i) = Split(Split(Range("A" & i), "#")(1), "%")(0)
        Range("D" & i) = Split(Split(Split(Range("A" & i), "#")(1), "%")(1), "&")(0)
        Range("E" & i) = Split(Range("A" & i), "&")(1)
    Next
End Sub
.
 

leonadies

Excel Derya Deniz Bizde Kulaç Atmaya Çalışıyoruz:)
Altın Üye
Katılım
12 Şubat 2015
Mesajlar
520
Excel Vers. ve Dili
Office 2016 TR 64 Bit Windows
Altın Üyelik Bitiş Tarihi
01-02-2027
Çok teşekkürler kıymetli üstadlar @Haluk @Korhan Ayhan

İki Kodda sorunsuz çalışıyor :)
 
Üst