Füge an deine Tabelle ein Feld namens Löschen, Typ Ja/Nein an.
Erstelle ein Modul und füge nachfolgenden Code ein:
Private sub doppelteLöschen()
dim Rec1 as adodb.recordset
dim z as long
dim strSQL as string
set rec1=new adodb.recordset
dim gw1 as long, gw1alt as long 'Datentyp von zaehler
dim gw2 as long, gw2alt as long 'Datentyp von nenner
dim gw3 as long, gw3alt as long 'Datentyp von Fläche_ALK
dim gw4 as long, gw4alt as long 'Datentyp von Stand_ALK
currentproject.connection.execute „Delete from Flurstück
where Löschen=0“
strSQL = " Select zaehler, nenner, Fläche_ALK, Stand_ALK "
strSQL = strSQL & " FROM Flurstück "
strSQL = strSQL & " ORDER By zaehler, nenner, Fläche_ALK,
Stand_ALK "
Rec1.open strSQL, currentproject.connection,
adOpenForwardOnly, adLockReadOnly
if rec1.eof=false then
gw1=rec1!zaehler: gw2=rec1!nenner: gw3=rec1!Fläche_ALK:
gw4=rec1!Stand_Alk
else
gw1=-1: gw2=-1: gw3=-1: gw4=-1 ’ oder ein anderer Wert,
der in
'Feldern nicht vorkommt
End if
while gw1-1 and gw2-1 and gw3-1
and gw4-1
z=0
gw1alt=gw1: gw2alt=gw2: gw3alt=gw3: gw4alt=gw4
while gw1=gw1alt and gw2=gw2alt and gw3=gw3alt and
gw4=gw4alt
z=z+1
if z>1 then
currentproject.connection.execute „Update
Flurstück set Löschen=-1 where zaehler=“ & gw1 &" and nenner
=" & gw2 and &" FLÄCHE_ALK = " & gw3 &" and Stand_Alk=" & gw4
end if
rec1.movenext
if rec1.eof=false then
gw1=rec1!zaehler: gw2=rec1!nenner:
gw3=rec1!Fläche_ALK: gw4=rec1!Stand_Alk
else
gw1=-1: gw2=-1: gw3=-1: gw4=-1 ’ oder ein
anderer Wert, der in
'Feldern nicht vorkommt
End if
wend
wend
rec1.close: set rec1=nothing
currentproject.connection.execute „Delete from Flurstück
where Löschen=-1“
end sub
PS: Das ganze heißt normierte Programmieriung -
Gruppenverarbeitung und existiert auch als DIN.
Wenn Fläche_ALK ein Kommazahlentyp ist, muss die
Updateanweisung so aussehen:
„Update Flurstück set Löschen=-1 where zaehler=“ & gw1 &" and
nenner =" & gw2 and &" FLÄCHE_ALK = " & str(gw3) &" and
Stand_Alk=" & gw4
DAnke für den ausführlichen Code, verstehe Ihn aber auf die schnelle nicht.
Deswegen nochmal ne andere Frage.
Ich habe versucht mit der delete Anweisung zu arbeiten, funktioniert nicht, da er mir sagt, datentypen in kriterienausdruck unverträglich.
Kannst Du mir dazu weiterhelfen?
Private Sub DatensatzLöschen_Click()
Dim strSQL As String
Dim Flur As Integer, Zaehler As Integer, Stand As Date
Dim GB As Integer, Nenner As Integer, Fläche As Long, Bemerkung As Variant
On Error GoTo Err_DatensatzLöschen_Click
Zaehler = Me![lst_doppelt].Column(0)
Nenner = Me![lst_doppelt].Column(1)
Fläche = Me![lst_doppelt].Column(2)
Stand = Me![lst_doppelt].Column(6)
Flur = Me![lst_doppelt].Column(4)
GB = Me![lst_doppelt].Column(5)
Bemerkung = Nz(Me![lst_doppelt].Column(3), „“)
strSQL = " delete Flurstück_ID, Zaehler, Nenner, Fläche_ALK, Bemerkung, Flur_ID, Grundbuch_ID, Stand_ALK"
strSQL = strSQL & " from Flurstück "
strSQL = strSQL & " where (Flurstück.Zaehler)= " & Zaehler
strSQL = strSQL + " AND " & " (Flurstück.Nenner) = " & Nenner
strSQL = strSQL + " AND " & " (Flurstück.Fläche_ALK) = " & Fläche
strSQL = strSQL + " AND " & " (Flurstück.Bemerkung) = ‚" & Bemerkung & "‘ "
strSQL = strSQL + " AND " & " (Flurstück.Flur_ID) = " & Flur
strSQL = strSQL + " AND " & " (Flurstück.Grundbuch_ID) = " & GB
strSQL = strSQL + " AND " & " (Flurstück.Stand_ALK) = ‚" & Stand & "‘ "
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Exit_DatensatzLöschen_Click:
Exit Sub
Err_DatensatzLöschen_Click:
MsgBox Err.Description
Resume Exit_DatensatzLöschen_Click
End Sub
danke
