Hücre içi verilere göre ayrı sütunlar açma, aynı sırada sütunlara ayırma

[neohumorist]

Merhaba,
Öncelikle herkese merhaba.
Danışmak istediğim bilgiyi forumda aradım ama bulamadım.
Yine de mükerrer bir konu olduysa affola lütfen.
Sorunum şu.
Elimde hücrelere virgülle sıralı şekilde dizilmiş tek sütun, belirli sayılardan oluşmuş bir tablo(lar) var (diyelimki 1 den 13e kadar).

Ben hücre içi verilere göre sütun açmak ve o verileri aynı sıralada 1 değerinde yerleştirmek istiyorum. Yani örneğin veri :

A1 hücresi 1,3,7,9,10
A2 hücresi 2,8,11,12,13,16

ise ben ekte 'düzeltilmiş' adlı dosyadaki gibi istiyorum.

bunu yapmanın en kolay yolu nedir acaba?
Yapmam gerekenlere örnek olarak elimdeki doyaların en küçüğünü 'sıralı' isminde ekte yolluyorum. Şimdiden teşekkür ederim.

 

[neohumorist]

Merhaba,
Öncelikle herkese merhaba.
Danışmak istediğim bilgiyi forumda aradım ama bulamadım.
Yine de mükerrer bir konu olduysa affola lütfen.
Sorunum şu.
Elimde hücrelere virgülle sıralı şekilde dizilmiş tek sütun, belirli sayılardan oluşmuş bir tablo(lar) var (diyelimki 1 den 13e kadar).

Ben hücre içi verilere göre sütun açmak ve o verileri aynı sıralada 1 değerinde yerleştirmek istiyorum. Yani örneğin veri :

A1 hücresi 1,3,7,9,10
A2 hücresi 2,8,11,12,13,16

ise ben ekte 'düzeltilmiş' adlı dosyadaki gibi istiyorum.

bunu yapmanın en kolay yolu nedir acaba?
Yapmam gerekenlere örnek olarak elimdeki doyaların en küçüğünü 'sıralı' isminde ekte yolluyorum. Şimdiden teşekkür ederim.

Mesajdaki hataları düzelttim.

 

[Necdet]

Merhaba,

Makro ile çözüm isterseniz aşağıdaki kodların bir Modul'e kopyalayıp deneyiniz.

Sub Ayir()
    
    Dim i   As Long, _
        j   As Long, _
        d
    
    Application.ScreenUpdating = False
    
    Range(Cells(2, "B"), Cells(Rows.Count, Columns.Count)).ClearContents
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        d = Split(Cells(i, "A"), ",")
        For j = 0 To UBound(d)
            Cells(i, d(j) + 1) = 1
        Next j
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır...."
    
End Sub

 

[neohumorist]

Merhaba,

Makro ile çözüm isterseniz aşağıdaki kodların bir Modul'e kopyalayıp deneyiniz.

Sub Ayir()
    
    Dim i   As Long, _
        j   As Long, _
        d
    
    Application.ScreenUpdating = False
    
    Range(Cells(2, "B"), Cells(Rows.Count, Columns.Count)).ClearContents
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        d = Split(Cells(i, "A"), ",")
        For j = 0 To UBound(d)
            Cells(i, d(j) + 1) = 1
        Next j
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır...."
    
End Sub

Gerçekten çok işime yaradı, çok teşekkür ederim...