metin ayırmak

bu koddan nerede hata var

DoCmd.RunSQL "INSERT INTO Tablo1 (SrNO, tani, tcno, prot) SELECT Sr, trim(Metin7), trim(Metin11), trim(Metin15) WHERE (((Trim(Metin7)) Is Not Null));"

teşekkürler

Sayın accessman;
Power arkadaşımız olayı çözmüş. Kendisine teşekkür ediyorum. Yalnız sizin açınızdan çözmeniz gereken bir sorun var. İlaçları ayırırken "," baz alıyorsunuz. Ama bazı ilaçların içeriğinde özellikle mg ,buçuk ifadelerinde de "," virgül kullanıldığı için sonuçlar umduğunuz gibi olmayacaktır. Eski dosyanızın ilaç kısmında bir takım işlemler daha yapmanız lazım gibime geliyor.
Kolay gelsin

o virgül karmaşasından sonra bende vazgeçtim. noktalı virgül olsa tamam belki kolay olur ama virgüllerle zor.

sn.power virgül olayını halletmiş gözüküyor
sadece olayı dao ile çözmek kalmış
ilginiz için teşekkürler

Ufuk hocanın 17. mesajındaki örnekteki kodlarda bulunan "DoCmd.RunSQL" kodları yerine ADO ekledim.

Private Sub Komut10_Click()

On Error GoTo HATA



'DoCmd.RunSQL "DELETE '*' FROM Tablo1"

'DoCmd.RunSQL "DELETE '*' FROM Tablo2"



    Dim SQL1 As String

    Dim SQL2 As String

    Dim db As Database

    Set db = CurrentDb

    

        DoCmd.SetWarnings False

            

        SQL1 = "DELETE * FROM Tablo1;"

        SQL2 = "DELETE * FROM Tablo2;"

        db.Execute SQL1

        db.Execute SQL2

        DoCmd.SetWarnings True

        Set db = Nothing





Metin7 = Null

Metin6 = Null



For C = 1 To DCount("no", "Sorgu24") + 1



If IsNull(Tanı) Then GoTo 100

For i = 1 To Len(Tanı)

 If i = 1 Then

    Metin7 = Mid(Tanı, i, 1)

        Else

            If Mid(Tanı, i, 1) = "," And Mid(Tanı, i - 1, 1) = " " Then

            'DoCmd.RunSQL "INSERT INTO Tablo1 (SrNO, tani, tcno, prot) SELECT Sr, trim(Metin7), trim(Metin11), trim(Metin15);"

strSQL = "SELECT * FROM Tablo1 "

Set rstkayit = New ADODB.Recordset

rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic



With rstkayit

.AddNew

.Fields("SrNO") = Me.Sr

.Fields("tani") = Me.Metin7

.Fields("tcno") = Me.Metin11

.Fields("prot") = Me.Metin15

.Update

End With

            

                Metin7 = ""

            Else

                Metin7 = Metin7 & Mid(Tanı, i, 1)

            End If

        End If

    Next i

    

strSQL = "SELECT * FROM Tablo1 "

Set rstkayit = New ADODB.Recordset

rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic



With rstkayit

.AddNew

.Fields("SrNO") = Me.Sr

.Fields("tani") = Me.Metin7

.Fields("tcno") = Me.Metin11

.Fields("prot") = Me.Metin15

.Update

End With

    

    

' DoCmd.RunSQL "INSERT INTO Tablo1 ( SrNO, tani ,tcno,prot) SELECT Sr, trim(Metin7), trim(Metin11), trim(Metin15);"

100

If IsNull(ilac) Then DoCmd.GoToRecord , , acNext: GoTo 200

    For i = 1 To Len(ilac)

        If i = 1 Then

            Metin7 = Mid(ilac, i, 1)

        Else

            If Mid(ilac, i, 1) = "," And Mid(ilac, i - 1, 1) = " " Then



strSQL = "SELECT * FROM Tablo2 "

Set rstkayit = New ADODB.Recordset

rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic



With rstkayit

.AddNew

.Fields("SrNO") = Me.Sr

.Fields("ilac") = Me.Metin7

.Fields("tcno") = Me.Metin11

.Fields("prot") = Me.Metin15

.Update

End With



     '       DoCmd.RunSQL "INSERT INTO Tablo2 ( SrNO, ilac ,tcno,prot) SELECT Sr, trim(Metin7), trim(Metin11), trim(Metin15);"

                Metin7 = ""

            Else

                Metin7 = Metin7 & Mid(ilac, i, 1)

            End If

        End If

    Next i

         '   DoCmd.RunSQL "INSERT INTO Tablo2 ( SrNO, ilac ,tcno,prot) SELECT Sr, trim(Metin7), trim(Metin11), trim(Metin15);"

strSQL = "SELECT * FROM Tablo2 "

Set rstkayit = New ADODB.Recordset

rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic



With rstkayit

.AddNew

.Fields("SrNO") = Me.Sr

.Fields("ilac") = Me.Metin7

.Fields("tcno") = Me.Metin11

.Fields("prot") = Me.Metin15

.Update

End With

            DoCmd.GoToRecord , , acNext

200

Next C

    DoCmd.Close

CIKIS: Exit Sub

HATA:  MsgBox Err.Description

       Resume CIKIS

        

End Sub

çok teşekkürler
ellerinize sağlık
16000 kayıt olunca 5-10 dk sürüyor
daha kısa sürecek şekilde nasıl yapılabilir
tekrar teşekkürler admin