Hücrede bulunan birden fazla ":" karakterinin kaçıncı sıralardada olduğu

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Hücrede bulunan birden fazla ":" karakterinin kaçıncı sıralarda olduğunu yardımcı sütun kullanarak fonksiyonla ekli dosyada görüldüğü gibi buluyorum. Makro ile nasıl bulurum.
Saygılarımla

 

[Korhan Ayhan]

Merhaba,

Eğer amacınız örnekteki gibi sayısal verileri almak ise görseldeki gibi bir işlem ile sonuca gidebilirsiniz.

 

[Tevfik_Kursun]

Günaydın Korhan Hocam,
Evet derdim sayıları almak, makroyu yazdım ama bir yerde döküm alamadım. Böyle çok sayıda farklı testin verisi var. Bunları datanın hizasına yan yana almak istiyorum.
Saygılarımla

 

[Korhan Ayhan]

Ben size basit bir örnek verdim. Siz bu kodu döngüye alıp kullanabilirsiniz.

Yapamam derseniz bahsettiğiniz veriyi içeren örnek dosya paylaşınız.

 

[Tevfik_Kursun]

Sayın Hocam,
Döngüyü denemedim. Hemen deneyeyim.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Korhan Hocam,
Sanırım el verseniz daha iyi olacak.
Saygılarımla

 

[veyselemre]

Sub test1()
    With CreateObject("Vbscript.Regexp")
        .Pattern = "\d"
        .Global = True
        al = Range("B1").Value
        If .Test(al) Then
            sut = 4
            For Each mtch In .Execute(al)
                Cells(1, sut).Value = Val(mtch)
                sut = sut + 1
            Next
        End If
    End With
End Sub

Sub test2()
    With CreateObject("Vbscript.Regexp")
        .Pattern = """\w"":\s(\d)"
        .Global = True
        al = Range("B1").Value
        If .Test(al) Then
            sut = 4
            For Each mtch In .Execute(al)
                Cells(1, sut).Value = mtch.submatches(0)
                sut = sut + 1
            Next
        End If
    End With
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
İlginize çok teşekkür ederim.
Saygılarımla

 

[Korhan Ayhan]

Alternatif..

Önerdiğim kodun dosyanıza uyarlanmış hali;

Option Explicit

Sub Test()
    Dim My_Text As String, My_Data As Variant, X As Byte, Y As Byte
    
    My_Text = Range("B1").Text
    My_Data = Split(Replace(My_Text, ":", ","), ",")
    
    Range("A2").Resize((UBound(My_Data) + 1) / 2, 2).ClearContents
    
    Y = 2
    
    For X = LBound(My_Data) To UBound(My_Data) Step 2
        Cells(Y, 1) = My_Data(X)
        Cells(Y, 2) = My_Data(X + 1)
        Y = Y + 1
    Next X
End Sub

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
İlginize çok teşekkür ederim.
Saygılarımla