Hallo,
ich habe eine locale Tabelle mit 21.000.000 Datensätzen und möchte diese gerne über eine ID zusammenfügen und in eine neue Tabelle schreiben.
Die Tabelle ist so aufgebaut:
ID | Text
1 | Hallo
1 | test2
2 | abc
2 | def
3 | xxx
3 | yyy
3 | zzz
Anfügeabfrage:
INSERT INTO tbl_textilkennzeichen ( SEARTE2, SEKOMPFINAL )
SELECT DISTINCT abfrage_textilkennzeichen.SEARTE2, "<br><br>" & FnsGetFields("SEKOMPZZ","abfrage_textilkennzeichen","SEARTE2",[SEARTE2],False,"<br>") AS SEKOMPFINAL
FROM abfrage_textilkennzeichen
GROUP BY abfrage_textilkennzeichen.SEARTE2, "<br><br>" & FnsGetFields("SEKOMPZZ","abfrage_textilkennzeichen","SEARTE2",[SEARTE2],False,"<br>");
' Menue: Extras -> Verweise Microsoft DAO 3.xx Object Library muss aktiv sein!
Option Compare Database
Option Explicit
Public Function FnsGetFields(sField As String, sTableOrQuery As String, _
sIndex As String, vIndex As Variant, _
Optional bIndexIsText As Boolean = False, _
Optional sSeparator As String = vbCrLf) As String
Dim s As String
Dim sSQL As String
Dim rs As DAO.Recordset
sSQL$ = "SELECT * FROM " & sTableOrQuery$ & " WHERE " & sIndex$
If IsNull(vIndex) Then
sSQL$ = sSQL$ & " Is Null"
ElseIf bIndexIsText Then
sSQL$ = sSQL$ & "='" & vIndex & "'"
Else
sSQL$ = sSQL$ & "=" & vIndex
End If
Set rs = CurrentDb.OpenRecordset(sSQL$)
If Not rs.EOF Then
rs.MoveFirst
s$ = Nz(rs.Fields(sField$), "")
rs.MoveNext
Do While Not rs.EOF
s$ = s$ & sSeparator$ & Nz(rs.Fields(sField$))
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
FnsGetFields$ = s$
End Function
Zieltabelle sollte dann so aussehen:
ID | Text
1 | Hallo, test2
2 | abc, def
3 | xxx, yyy, zzz
Ich habe folgendes ausprobiert:
FnsGetFields
ConcatVar
SQLListe
Leider kommt die Abfrage jeweils auf Grund der großen Datenmenge nicht zum Ende.
Gibt es eine andere Lösung?
Vielen Dank
Hallo,
reduziere das Ganze mal auf das Notwendigste:
Public Function Test()
Dim rs As DAO.Recordset, db As Database, lngID As Long, strText As String
Set db = CurrentDb
Set rs = db.OpenRecordset("select id, txtText from Tabelle1 order by id", dbOpenSnapshot)
lngID = rs!ID
Do Until rs.EOF
If lngID <> rs!ID Then
db.Execute "insert into Tabelle11 (id,txtText) Values(" & lngID & ",'" & Mid(strText, 2) & "')"
strText = ""
lngID = rs!ID
Else
strText = strText & "," & rs!txtText
rs.MoveNext
End If
Loop
db.Execute "insert into Tabelle11 (id,txtText) Values(" & lngID & ",'" & Mid(strText, 2) & "')", dbFailOnError
rs.Close
Set rs = Nothing: Set db = Nothing
End Function
Hallo Franz,
Vielen Dank
MEGASCHNELL!!!! ;D
Hätte nur noch ein Problem, und zwar haben die IDs führende Nullen und jetzt wird das Ergebniss einmal mit führender Null und einmal ohne, also immer doppelt in die neue Tabelle geschrieben.
Hallo,
ist ja auch Unsinn , eine ID-Zahl als Text auszuführen.. Brauchst Du denn die führende 0 überhaupt?
Ansonsten stell den Code auf Datentyp String bei der Variablen lngID um.
Hallo,
jetzt kommt der Knaller....
In den Feldinhalten wurden Sonderzeichen, z.B. ' verwendet und die Abfrage läuft hier immer auf Fehler.
Gibt es dafür eine Lösung? Ausser vorher die ' zu löschen?
Vielen Dank
Hallo,
wenn es beim Hochkomma bleibt, kann man die Replace-Funktion benutzen:
db.Execute "insert into Tabelle11 (id,txtText) Values(" & lngID & ",'" & Mid(Replace(strText,"'","''"), 2) & "')", dbFailOnError