e-okul Öğrenci Künye Defterinden Öğrenci Listesi Oluşturma

Sub ImportStudentDataWithDateParsing()
    Dim ws As Worksheet
    Dim currentRow As Long
    Dim srcSheet As Worksheet
    Dim studentRow As Long
    Dim studentNumber As String
    Dim studentName As String
    Dim studentSurname As String
    Dim studentBirthRaw As String
    Dim studentBirth As Variant
    Dim studentTC As String
    Dim studentClass As String

    currentRow = 2 ' Başlıklar 1. satırda olacak, veri 2. satırdan başlayacak

    ' "Öğrenci Listesi" sayfasını kontrol et
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("Öğrenci Listesi")
    On Error GoTo 0

    If Not ws Is Nothing Then
        If MsgBox("Daha önce liste aktarılmış, listeyi yeniden aktarmak istiyor musunuz?", vbYesNo + vbQuestion) = vbYes Then
            ' Önceki sayfayı sil
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        Else
            Exit Sub
        End If
    End If

    ' Yeni "Öğrenci Listesi" sayfası oluştur
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "Öğrenci Listesi"

    ' Başlıkları ekle
    ws.Cells(1, 1).Value = "S.No"
    ws.Cells(1, 2).Value = "Öğrenci No"
    ws.Cells(1, 3).Value = "Adı"
    ws.Cells(1, 4).Value = "Soyadı"
    ws.Cells(1, 5).Value = "Doğum Tarihi"
    ws.Cells(1, 6).Value = "T.C. No"
    ws.Cells(1, 7).Value = "Sınıfı"

    ' Başlıkları biçimlendir
    ws.Rows(1).Font.Bold = True
    ws.Rows(1).HorizontalAlignment = xlCenter

    ' Kaynak dosyayı seç
    Dim filePath As String
    filePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Öğrenci Dosyasını Seçin")
    If filePath = "False" Then Exit Sub

    ' Kaynak dosyayı aç
    Application.ScreenUpdating = False
    Workbooks.Open filePath
    Set srcSheet = ActiveWorkbook.Sheets(1)

    ' Veriyi işlemeye başla
    studentRow = 2 ' İlk öğrenci bilgisi D2 hücresinden başlıyor

    Do While Not IsEmpty(srcSheet.Cells(studentRow, 4)) ' D sütunu boş değilse devam et
        ' Verileri kaynak hücrelerden al
        studentNumber = srcSheet.Cells(studentRow, 4).Value ' Öğrenci No: D2, D24, ...
        studentName = srcSheet.Cells(studentRow + 1, 4).Value ' Adı: D3
        studentSurname = srcSheet.Cells(studentRow + 2, 4).Value ' Soyadı: D4
        studentBirthRaw = srcSheet.Cells(studentRow + 5, 4).Value ' Doğum Yeri ve Tarihi: D7
        studentTC = srcSheet.Cells(studentRow + 7, 4).Value ' TC NO: D9
        studentClass = srcSheet.Cells(studentRow + 13, 11).Value ' Sınıf: K15

        ' Doğum tarihini kontrol et ve geçerli bir tarih olup olmadığını doğrula
        On Error Resume Next
        studentBirth = DateValue(studentBirthRaw)
        On Error GoTo 0

        ' Eğer tarih geçerli değilse, 'Hatalı Format' olarak işaretle
        If IsDate(studentBirth) Then
            studentBirth = Format(studentBirth, "dd/mm/yyyy") ' Tarihi gg/aa/yyyy formatına dönüştür
        Else
            studentBirth = "Hatalı Format"
        End If

        ' Verileri hedef sayfaya ekle
        ws.Cells(currentRow, 1).Value = currentRow - 1 ' S.No
        ws.Cells(currentRow, 2).Value = studentNumber
        ws.Cells(currentRow, 3).Value = studentName
        ws.Cells(currentRow, 4).Value = studentSurname
        ws.Cells(currentRow, 5).Value = studentBirth
        ws.Cells(currentRow, 6).Value = studentTC
        ws.Cells(currentRow, 7).Value = studentClass

        ' Sonraki satıra geç
        currentRow = currentRow + 1
        studentRow = studentRow + 22 ' Her öğrenci 22 satır arayla geliyor
    Loop

    ' Kenarlıklar ekle
    ws.Range(ws.Cells(2, 1), ws.Cells(currentRow - 1, 7)).Borders.LineStyle = xlContinuous

    ' Sütun genişliklerini ayarla
    ws.Columns("A:G").AutoFit

    ' Kaynak dosyayı kapat
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True

    MsgBox "Veriler başarıyla aktarıldı!", vbInformation
End Sub