Hücre içindeki farklı tarihleri bir satıra yazdırma

[kneehot]

Arkadaşlar merhaba, Anlatması biraz zor olduğu için örnek ekledim. Kısaca hücreler içerinde yazan tarihlerden farklı olanları bir satıra yan yana yazdırmak istiyorum. Belki formül ile de yapılabiliyordur bilmiyorum ama makro ile olabilir gibi geldi. Örnek içinde çok daha anlaşılır durumda. Şimdiden yardımlara çok teşekkür ederim

 

[veyselemre]

Sub test()
    Dim elem, bbb, bb, b, ky, i, ii

    With CreateObject("Scripting.Dictionary")
        For Each elem In Range("B6:B8").Value
            For Each bbb In Split(elem, "/")
                bb = Split(bbb, " (", 2)(0)
                b = Split(bb, " - ")
                ky = Format(b(1), "yyyymmdd") & b(1) - b(0)
                .Item(ky) = bb
            Next bbb
        Next elem
        ky = .keys
        bb = .items
        For i = 0 To UBound(ky) - 1
            For ii = i + 1 To UBound(ky)
                If ky(i) > ky(ii) Then
                    b = ky(i)
                    ky(i) = ky(ii)
                    ky(ii) = b
                    b = bb(i)
                    bb(i) = bb(ii)
                    bb(ii) = b
                End If
            Next ii
        Next i
    End With
    For i = 0 To UBound(bb)
        Cells(6, i + 3).Value = bb(i)
    Next i
End Sub

 

[kneehot]

Sub test()
    Dim elem, bbb, bb, b, ky, i, ii

    With CreateObject("Scripting.Dictionary")
        For Each elem In Range("B6:B8").Value
            For Each bbb In Split(elem, "/")
                bb = Split(bbb, " (", 2)(0)
                b = Split(bb, " - ")
                ky = Format(b(1), "yyyymmdd") & b(1) - b(0)
                .Item(ky) = bb
            Next bbb
        Next elem
        ky = .keys
        bb = .items
        For i = 0 To UBound(ky) - 1
            For ii = i + 1 To UBound(ky)
                If ky(i) > ky(ii) Then
                    b = ky(i)
                    ky(i) = ky(ii)
                    ky(ii) = b
                    b = bb(i)
                    bb(i) = bb(ii)
                    bb(ii) = b
                End If
            Next ii
        Next i
    End With
    For i = 0 To UBound(bb)
        Cells(6, i + 3).Value = bb(i)
    Next i
End Sub

Çok teşekkür ederim yardımlarınız için