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

Katılım
11 Kasım 2010
Mesajlar
22
Excel Vers. ve Dili
2013 Türkçe
Altın Üyelik Bitiş Tarihi
11-05-2024
Ç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
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
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
 
Katılım
11 Kasım 2010
Mesajlar
22
Excel Vers. ve Dili
2013 Türkçe
Altın Üyelik Bitiş Tarihi
11-05-2024
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.
 
Üst