Positionsnummervergabe

[Bernie110]

Hallo,

wie würdet ihr folgendes machen.

Ich hab eine Tabelle Tbl_Sendungen die folgende Felder beinhaltet

DT_Nr = Autowert + Pk
Entpadepos = Zahlenfeld
Tour_Nr = Zahlenfeld
Empfänger_Name = Textfeld
Empfänger_Strasse = Textfeld
Empfänger_Land = Textfeld
Empfänger_Plz = Textfeld
Empfänger_Ort = Textfeld

Diese Tabelle wird mit Tbl_Fahrzeuge verknüpft ( via Tour_Nr und Pk der Tabelle_Fahrzeuge )

In das Feld Entladepos tragen wir manuell Nummern von 1 - x ein.
Das ist eine Art Positionsnummer.

Beim Eintrag einer Nummer in das Feld "Entladepos" achten wir darauf, dass Sendungen an den selben Empfänger die gleiche Nummer haben.

Sieht dann etwa so aus.

DT_Nr   Entladepos     Tour_Nr        Empfänger_Name       Empfänger_Ort
------------------------------------------------------------------------------------------------------
1001             1                 10            Müller                          München
1002             2                 10            Schmitt                        Stuttgart
1003             1                 10            Müller                          München
1004             3                 10            Meyer                          Karlsruhe
1005             4                 10            Paul                             Ulm
1006             1                 10            Müller                          München
1007             2                 10            Schmitt                        Stuttgart.



So und ich suche nun nach einer Möglichkeit die Nummer per Vba automatisch einzutragen.

habt Ihr eine Idee wie man das machen könnte ?

Gruss
Bernie

[DF6GL]

Hallo,

wenn Du per Abfrage (SQL) auf diese Liste mittels passender Kriterien zugreifen kannst, dann etwa so:


Recordset mit o. g. Abfrage, die nach Name, Ort und evtl. DT_Nr sortiert,  öffnen und mit einer Schleife durchlaufen.  Bei jedem Durchlauf wird dem Feld  "Entladepos" beginnend mit 1 die PosNr zugewiesen und bei einem (Gruppen)-Wechsel (Name und Ort ändert sich, auf den natürlich getestet werden muss) die Pos-Nr. um 1 erhöht.

[Bernie110]

Hi Franz,

ok..ich hab das mal versucht.. auf die Art ...oder ?

CurrentDb.Execute "Update DT_Erfassung Set Entladepos='" & rs!EntladePos & "' where TourNr = " & rs!TOURNR & " And EMPF_Adresse2 Like '" & rs!EMPF_Adresse2 & "' And EMPF_Ort like '" & rs!EMPF_Ort & "'"


aber wie bring ich dann eine Schleife unter ?

Keinen Plan  
Kannst du mir bitte "mal" wieder helfen ?

Danke Gruss
Bernie

[Bernie110]

Ok du meinst es auf die Art... aber ich krieg das trotzdem nicht hin 

Dim zaehler As Long
Dim strSQL As String
Dim DB As DAO.Database
Dim rs As DAO.Recordset



If Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.Recordset.RecordCount > 0 Then
Set rs = Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.RecordsetClone

Do Until rs.EOF
rs.Edit

Set DB = CurrentDb
strSQL = "SELECT  a.LfdNr "
     strSQL = strSQL & " FROM DT_Erfassung AS a order by Empf_Adresse1 order by EMPF_Adresse1"
    strSQL = strSQL & " WHERE a.ABG_Firmenname1='" & rs!ABG_FirmenName1 & "'"
    strSQL = strSQL & " And a.TourNr =" & rs!TOURNR
    strSQL = strSQL & " And a.EMPF_Firmenname1='" & rs!EMPF_FirmenName1 & "'"
    strSQL = strSQL & " And a.EMPF_Adresse1='" & rs!EMPF_Adresse1 & "'"
    strSQL = strSQL & " And a.EMPF_Land='" & rs!EMPF_Land & "'"
    strSQL = strSQL & " And a.EMPF_Plz='" & rs!EMPF_Plz & "'"
    strSQL = strSQL & " And a.EMPF_Ort='" & rs!EMPF_Ort & "'"

zaehler = 0
rs!EntladePos = zaehler + 1

rs.Update
rs.MoveNext
Loop

Set DB = Nothing
Set rs = Nothing

End If

[DF6GL]

Hallo,


wenn die "Liste" ein Unterform ist, dann kannst Du die SQL-(Abfrage) einsparen...

Code [Auswählen] Erweitern


Dim rs As DAO.Recordset
Dim i As Long, aktOrt As String, aktName As String


If Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.Recordset.RecordCount > 0 Then

Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.OrderBy = "Empf_Adresse1 ,  EMPF_Ort"
Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.OrderByOn = True

Set rs = Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.RecordsetClone
rs.MoveFirst

aktOrt = rs!EMPF_Ort
aktName = rs!Empf_Adresse1
i = 0

Do Until rs.EOF
   If aktOrt = rs!EMPF_Ort And aktName = rs!Empf_Adresse1  Then
     i = i + 1
   Else
     i = 1
     aktOrt = rs!EMPF_Ort
     aktName = rs!Empf_Adresse1
   End If
 
 
rs.Edit
   rs!EntladePos  = i
rs.Update
 
 
rs.MoveNext
Loop
 
rs.Close: Set rs = Nothing
 
End If

[Bernie110]

Hi Franz,

vielen Dank ersteienmal.

Leider funktioniert der Code nicht. ( Also der Code schon, aber nicht so wie er funktionieren sollte)

Er vergibt zwar Nummern, aber berücksichtigt dabei nicht, dass ,wie bei o.g. Beispiel gezeigt, mehrere Sendungen an den gleichen Empfänger auch die gleiche Nummer erhalten soll.

Er vergibt für einige DS die Nummer 1 , obwohl er schon bei einem Empfänger mit der selben Adresse die Nr 2 vergeben hat.

Zum verständnis
bei diesem Code macht er es richtig : Allerdigns mit manueller hilfe

If Me.EntladePos > 0 Then
RunCommand acCmdSaveRecord
CurrentDb.Execute "Update DT_Erfassung Set Entladepos='" & Me!EntladePos & "' where TourNr = " & Me!TOURNR & " And EMPF_Adresse2 Like '" & Me.EMPF_Adresse2 & "' And EMPF_Ort like '" & Me.EMPF_Ort & "'"
End If

Bei diesem Code, muss ich die Nummer 1,2,3,4,usw, manuell eintragen, aber er teilt die gleiche nummer für jeden DS mit dem gleichen Empfänger weiter.

Soll das dieser Code auch so bewirken ?

Gruss Bernie

[DF6GL]

Hallo,

ja, ok und sorry, habe das "verwechselt"   



So etwa:

Code [Auswählen] Erweitern

Dim rs As DAO.Recordset
Dim i As Long, aktOrt As String, aktName As String


If Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.Recordset.RecordCount > 0 Then

Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.OrderBy = "Empf_Adresse1 ,  EMPF_Ort"
Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.OrderByOn = True

Set rs = Me!TOUR_ERFASSUNG_SchnellFrm_DT_UFO.Form.RecordsetClone
rs.MoveFirst

aktOrt = rs!EMPF_Ort
aktName = rs!Empf_Adresse1

i = 1
 
Do Until rs.EOF
   If Not (aktOrt = rs!EMPF_Ort And aktName = rs!Empf_Adresse1)  Then
     i = i + 1
     aktOrt = rs!EMPF_Ort
     aktName = rs!Empf_Adresse1
   End If
 
 
rs.Edit
   rs!EntladePos  = i
rs.Update
   
rs.MoveNext
Loop
 
rs.Close: Set rs = Nothing
 
End If

[Bernie110]

Wow super, danke !! 

Funzt einwandfrei

Gruss
Bernie