Aynı hücrede yazılı tarihleri ayırmak

[endersen]

Çok kıymetli Üstadlarım,

Bir programdan rapor alıyorum ve o raporda vade tarihlerini aynı hücre içerisinde veriyor. Bazı kişilerde bu tarih bilgisi 1,2,3,7 olabiliyor. Aynı hücre içerisine girilmiş tarihleri alt alta ve ayrı hücrelere çıkartmak istiyorum. Örnek dosyayı ekliyor, yardımlarınızı rica ederim.

Saygılarımla

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Tarihleri_Ayir()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant, Son As Long
    Dim X As Long, Say As Long, Tarih As Variant, Y As Integer
    
    Set S1 = Sheets("Raporda Gelen")
    Set S2 = Sheets("Olmasını İstediğim")
    
    S2.Range("A2:B" & S2.Rows.Count).Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = S1.Range("A2:B" & Son).Value
    
    ReDim Liste(1 To S1.Rows.Count, 1 To 2)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            Tarih = Split(Veri(X, 2), Chr(10))
            For Y = LBound(Tarih) To UBound(Tarih)
                If Tarih(Y) <> "" Then
                    Say = Say + 1
                    Liste(Say, 1) = Veri(X, 1)
                    Liste(Say, 2) = CDate(Tarih(Y))
                End If
            Next
        End If
    Next
    
    If Say > 0 Then
        S2.Range("A2").Resize(Say, 2) = Liste
        S2.Range("A1").CurrentRegion.Borders.LineStyle = 1
        S2.Select
        MsgBox "Tarihler ayrıştırılmıştır.", vbInformation
    Else
        MsgBox "Uygun kayıt bulunamadı.", vbExclamation
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[endersen]

Korhan Bey,

Elinize emeğinize sağlık, o kadar büyük bir yükten kurtardınız anlatamam. Çok teşekkür eder saygılarımı sunarım.