AccessTr.neT

Tam Versiyon: Metin içindeki virgülle ayrılan verileri farklı satıra yazma
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
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.
Sayfalar: 1 2 3