[pakos]

χαιρετω τα μελη

στον πινακα σου προσθεσε 3 πεδια

ari8moi => Αριθμός
thesi => Αριθμός
Nai => Σύντομο κείμενο


Εαν εχεις Function TableExist καλως αλλιως το παρακατω

Public Function TableExist(strTableName As String) As Boolean
Dim db As DAO.Database
Dim td As DAO.TableDef
Set db = CurrentDb
On Error Resume Next
Set td = db.TableDefs(strTableName)
TableExist = (Err.number = 0)
Err.Clear
End Function

Σε μια κενη φορμα εβαλα ενα κουμπι σε διαδικασια συμβαντος με το κλικ

Private Sub Εντολή2_Click()

If TableExist("Data_Result2") = True Then
DoCmd.RunSQL "DELETE Data_Result2.Data " & _
" FROM Data_Result2;"
Else
DoCmd.CopyObject , "Data_Result2", acTable, "Data_Result"
DoCmd.RunSQL "DELETE Data_Result2.Data " & _
" FROM Data_Result2;"
End If





Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim pattern As String
Dim item As String
Dim matches As Object
Dim match As Object
Dim number As String
Dim index As Integer
Dim result As String
Dim m As Object ' Declare loop variable

Set db = CurrentDb
Set rs = db.OpenRecordset("Data_Result")

pattern = "\d{4}" ' Regular expression pattern to match 4-digit numbers

rs.MoveFirst
Do Until rs.EOF
item = rs("Data")


Set matches = CreateObject("VBScript.RegExp")
matches.Global = True
matches.IgnoreCase = True
matches.pattern = pattern

Set match = matches.Execute(item)
If match.Count > 0 Then
For Each m In match
number = m.Value
index = InStr(item, number)

rs.AddNew
rs![Data] = item
rs![Nai] = "ναι"
rs![ari8moi] = number
rs![thesi] = index
rs.Update
Next m
End If

rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

DoCmd.RunSQL "INSERT INTO Data_Result2 ( Data, ari8moi, thesi ) " & _
" SELECT Data_Result.Data, Data_Result.ari8moi, Data_Result.thesi " & _
" FROM Data_Result " & _
" WHERE (((Data_Result.Nai)=""ναι""));"

DoCmd.RunSQL "DELETE Data_Result.Data, Data_Result.ari8moi, Data_Result.thesi, Data_Result.Nai " & _
" FROM Data_Result " & _
" WHERE (((Data_Result.Nai)=""ναι""));"

DoCmd.RunSQL "UPDATE Data_Result2 LEFT JOIN Data_Result ON Data_Result2.Data = Data_Result.Data SET Data_Result.ari8moi = [Data_Result2]![ari8moi], Data_Result.thesi = [Data_Result2]![thesi];"


DoCmd.DeleteObject acTable, "Data_Result2"
End Sub


Οποτε στον πινακα σου εχεις το ζητουμενο και δεν χρειαζεσαι το ερωτημα
μπορεις με την instr στα πεδια του πινακα σου να επιλεξεις πριν και μετα την εγγραφη τα δεδομενα και να τα προσαρμοσεις μεσα στον κωδικα
rs![πριν] =left(item, InStr(1, item, number)-1)

Θεωρειτε βεβαιο οτι το πεδιο [πριν] υπαρχει στον πινακα σου αλλιως το προσθετεις
Βεβαια θα πρεπει να προσαρμοσεις και τους κωδικες
DoCmd.RunSQL "INSERT INTO Data_Result2 ( Data, ari8moi, thesi, πριν ) " & _
" SELECT Data_Result.Data, Data_Result.ari8moi, Data_Result.thesi, Data_Result.πριν " & _
" FROM Data_Result " & _
" WHERE (((Data_Result.Nai)=""ναι""));"

DoCmd.RunSQL "UPDATE Data_Result2 LEFT JOIN Data_Result ON Data_Result2.Data = Data_Result.Data SET Data_Result.ari8moi = [Data_Result2]![ari8moi], Data_Result.thesi = [Data_Result2]![thesi], Data_Result.πριν= [Data_Result2]![πριν];"


Επισυναπτω και το αρχειο