Sub ParseData()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim outputRs As DAO.Recordset
    Dim regex As Object
    Dim results As New Collection
    Dim item As Variant ' Degiskenin türünü Variant olarak ayarladik
    Dim parts() As String
    Dim lastPart As String
    Dim output As String
    
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Field FROM Table1") ' Tablo ve alan adinizi buraya yazin
    
    ' Regex deseni
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .IgnoreCase = True
        .Global = False
        .pattern = "^\d+_\d+_\d+-\d+"
    End With

    ' Kayit kümesi üzerinden döngü
    Do While Not rs.EOF
        item = rs.Fields(0).Value
        
        If regex.Test(item) Then
            parts = Split(item, "_")
            right_part = parts(UBound(parts))
            
            parts2 = Split(right_part, "-")
            
            ReDim parts3(UBound(parts2) - 1)
            
            For i = 0 To UBound(parts3)
                parts3(i) = parts2(i)
            Next i
            
            Dim res As String
            res = Join(parts3, "-")
            
            results.Add (res)
        End If
        
        rs.MoveNext
    Loop
    
    rs.Close
    
    ' Yeni tabloya sonuçlari ekleme
    On Error Resume Next ' Hata kontrolü için
    Set outputRs = db.OpenRecordset("Test", dbOpenDynaset) ' Yeni tablo adinizi buraya yazin
    
    If outputRs Is Nothing Then
        ' Yeni tablo yoksa, olustur
        db.Execute "CREATE TABLE NewTable (ResultField TEXT(255));" ' Alan adi ve tipi burada tanimlayin
        Set outputRs = db.OpenRecordset("NewTable", dbOpenDynaset)
    End If
    On Error GoTo 0 ' Hata kontrolünü sifirlama

    ' Sonuçlari ekleme
    For Each item In results
        Debug.Print item
        outputRs.AddNew
        outputRs.Fields("ResultField").Value = item ' Alan adini burada güncelleyin
        outputRs.Update
    Next item
    
    outputRs.Close
    Set outputRs = Nothing
    Set rs = Nothing
    Set db = Nothing
End Sub