Metin içindeki virgülle ayrılan verileri farklı satıra yazma

Aynı tabloda işlemin yapılmasını istiyorsanız tüm kodları silin aşağıdaki kodu yapıştırın...

Option Compare Database

Private Sub Komut0_Click()

Dim Sql As String

Dim rs, rt As DAO.Recordset

Set DB = CurrentDb()



SQL = "SELECT * FROM Tablo1"

Set rs = DB.OpenRecordset(SQL)

SQL = "SELECT * FROM Tablo1"

Set rt = DB.OpenRecordset(SQL)



rs.MoveFirst

Do Until rs.EOF

   ARA = rs!kisiler

   

10:

   A1 = InStr(ARA, ",")

   If A1 > 0 Then

      YENIISIM = Trim(Left(ARA, A1 - 1))

      ARA = Mid(ARA, A1 + 1)

      rt.AddNew

      rt!sınıf = rs!sınıf

      rt!kisiler = YENIISIM

      rt![sınıf durumu] = rs![sınıf durumu]

      rt.Update

      GoTo 10

   End If

   If A1 = 0 Then

      YENIISIM = Trim(ARA)

      rt.AddNew

      rt!sınıf = rs!sınıf

      rt!kisiler = YENIISIM

      rt![sınıf durumu] = rs![sınıf durumu]

      rt.Update

   End If

rs.Delete

rs.MoveNext

Loop



MsgBox "Tablo dolduruldu..."

End Sub

Cevaplarınız için teşekkür ederim. sorun yaşadığım örneği ekte gönderiyorum. ben kişileri tek bir virgülle ayrı olarak belirtmiştim. ancak üzerinde çalıştığım projede kişiler ''----------------' 16 adet tire ile ayrı. sizin örneğinizi bu şekilde değiştirdiğimde her bir satır için birer tane boş satır oluşturuyor. onun çözümünü bulamadım.

Option Compare Database



Private Sub Komut0_Click()

Dim Sql As String

Dim rs, rt As DAO.Recordset

Set DB = CurrentDb()



SQL = "SELECT * FROM Tablo1"

Set rs = DB.OpenRecordset(SQL)

SQL = "SELECT * FROM YENITABLO"

Set rt = DB.OpenRecordset(SQL)



rs.MoveFirst

Do Until rs.EOF

   ARA = rs!kisiler

   

10:

   A1 = InStr(ARA, "----------------")

                    

   If A1 > 0 Then

      YENIISIM = Trim(Left(ARA, A1 - 1))

      A2 = InStr(YENIISIM, ")")

      YENIISIM = Trim(Mid(YENIISIM, A2 + 1))

      ARA = Trim(Mid(ARA, A1 + 16))

      rt.AddNew

      rt!sınıf = rs!sınıf

      rt!kisiler = YENIISIM

      rt![sınıf durumu] = rs![sınıf durumu]

      rt.Update

      GoTo 10

   End If

   

rs.MoveNext

Loop



MsgBox "Tablo dolduruldu..."

End Sub

Kodu aşağıdaki ile değiştirin.

teşekkürler sn. @POWER

sn. @POWER cevabınız için teşekkür ederim.