ALT ALTA VERİLERİ YANYANA GETİR VCARD-VCF

[yasin85]

Herkese Merhaba,

Parça parça VCF-VCARD dosyalarım var onları düzeleyip düzgün bir telefon rehberi sistemi oluşturmak istiyorum.
Bu konuda VCF-VCARD dosyası oluşturma sistemleri çok fakat tersi işlemi alt alta değilde başlıklarına göre yan yana bir çalışma bulamadım.

Mümkün olması halinde ihtiyacımızdan bahsedeyim..

Alt Alta olan verileri ( A ) Sutün Başlıktır - ( B ) Sutün Veridir.
A Satırdaki başlıkları Sayfa2 Alıp benzersiz olarak Üst kısma başlık olarak yazılması ardından B Satırdaki ilgili aralıktaki verileri var ise o satır içine yazılmasıdır.

Kriterimiz bildiğiniz üzere VCF-VCARD sistemi BEGIN ile başlar END ile biter arasında kalan veriler ilgiliye ait bilgilerdir.

Örnek Excel Dosyası Ekledim
https://www.dosya.tc/server35/0h4bob/ALT_ALTA_VERILERI_YANYANA_GETIR_VCARD-VCF.xlsx.html

Yardımlarınızdan dolayı şimdiden teşekkür ederim.

 

[veyselemre]

Sub test()
    Dim say&, rng As Range, veri(), i&
    
    With Sheets("VERI")
        say = .Cells(Rows.Count, 1).End(3).Row
        Set rng = .Range("A2:A" & say)
        say = WorksheetFunction.CountIf(rng, "BEGIN:")
        veri = rng.Resize(, 2).Value
    End With
    
    ReDim lst(1 To say, 1 To 20)
    say = 0
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To 20
            .Item(Sheets("CIKTI").Cells(1, i).Value) = i
        Next i
        For i = 1 To UBound(veri)
            If veri(i, 1) = "BEGIN:" Then
                say = say + 1
            End If
            lst(say, .Item(veri(i, 1))) = veri(i, 2)
        Next i
    End With
    
    With Sheets("CIKTI")
        .Range("A2:T" & Rows.Count).ClearContents
        .Range("A2").Resize(say, 20).Value = lst
    End With

End Sub

 

[yasin85]

@veyselemre Bey Merhaba,

Gerçekten mükemmel bir çalışma olmuş resmen ömürlük çalışma bir çalışma bir haftadır bu işi kısıtlı excel bilgim ile uğraşıyordum.
Allah razı olsun sizden ve buradaki tüm yardım sever abilerimizden..

Tekrar teşekkürler kolay gelsin..