27. april 2004 - 16:30Der er
9 kommentarer og 1 løsning
finde hul i talserier
Jeg har nogle ringnumre i en tabel feks: 1234 1235 1236 1238 1240 1241 1242
Jeg laver en forespørgsel, der finder alle poster men i sorteret rækkefølge.(opad) Nu vil jeg gerne løbe disse poster igennem og i en anden tabel med to kolonner (start og slut)have gemt følgende: start slut -------------- 1234 1236 1238 1238 1240 1242 Altså tre poster med sammenhængende serier, som godt kan bestå af et enkelt ringnummer.
For at vanskeliggøre det hele lidt (af hensyn til udfordringen) er feltformat ikke tal men tekst, fordi nogle ringnumre starter med et ciffer, derpå kommer et bogstav, og derpå igen 5 cifre - f.eks. 9V12345
Regel er simpel nok, nemlig at det næste nummer i rækken er en (1) større end det foregående. Der findes 6 forskellige typer ringe. 4 cifre, eks 1234 5 cifre, eks 12345 6 cifre, eks 123456 7 cifre, 1234567 1 ciffer + 1 bogstav + 5 cifre, eks 9K12345 1 bogstav + 5 cifre, eks A12345
Da alle typer findes i samme tabel er felttypen nød til at være tekst.
og kører flg. sub kan du lave en valgfri gruppering af data
Sub xkey()
Dim rst1 As DAO.Recordset Set rst1 = CurrentDb.OpenRecordset("select * from tabel order by ringnum") oldKey = "" nr = 1 With rst1 Do While Not .EOF Key = !ringnum If Key <> oldKey Then 'denne test skal du sikkert tilrette nr = 1 oldKey = Key End If .Edit !key = nr .Update nr = nr + 1 .MoveNext Loop End With
Hej Tak for svar indtil nu. Jeg tror jeg lukker spørgsmålet lidt mens jeg roder videre. Jeg er nød til at behandle de tre venstre tegn i et ringnummer for sig og de sidste 4 tegn til højre, ligeledes for sig. Siden skal de to dele igen kombineres til ringnummeret.
zuschalg>If you are not happy with the help you have received so far, and intend closing the question, then it may be an idea to place an answer and accpet it yourself, that way youget your points back, and the question gets closed.
Hej Nu har jeg rodet mig frem til nedenstående kode som jeg synes skal ud. Det drejer sig om serier af ringnumre (på små alu/stål-ringe til ringmærkning af fugle), som ringmærkeren en gang årligt skal opgøre sin beholdning af. Da vi i databasen har en tabel med ringbeholdning ved årets start, og da ringene slettes fra den tabel efterhånden, som de optræder i tabellen over ringmærkede fugle, er det jo naturligt at ønske ringbeholdning udskrevet direkte ved årets udgang. Da det drejer sig om mange tusinde ringe, er det også naturligt at de ønskes udskrevet i serier. Ringnummeret kan være 4, 5, 6 eller 7 cifre, men kan også indeholde et bogstav som 1. eller 2. tegn fra venstre. Derfor er felttypen tekst. Nedenstående kode løser mit problem (for så vidt som min testning har taget højde for mærkelige kombinationer mm.) og kan også tilpasses, hvis man skulle finde på at lave ringe med 8 eller flere tegn. Efter kørsel står serierne i tblringbeholdningserier, som har to felter - ringnrstart og ringnrslut.
'''kode start''' Function ringserier() On Error Resume Next Dim db As Database Dim sql As String Dim rst As Recordset Dim rst2 As Recordset Dim glnr As Long Dim nynr As Long Dim nybog As String Dim glbog As String Dim ringnummer As String
Set db = CurrentDb db.Execute "delete * from tblringbeholdningserier" sql = "select * from tblringbeholdning order by ringnr" Set rst = db.OpenRecordset(sql) Set rst2 = db.OpenRecordset("tblringbeholdningserier") If rst.RecordCount > 0 Then rst.MoveFirst ringnummer = rst!ringnr If Len(ringnummer) = 4 Then ringnummer = " " & ringnummer glbog = Left(ringnummer, Len(ringnummer) - 5) glnr = Right(ringnummer, 5) rst2.AddNew rst2!ringnrstart = rst!ringnr rst2.Update rst.MoveNext Do Until rst.EOF ringnummer = rst!ringnr If Len(ringnummer) = 4 Then ringnummer = " " & ringnummer nybog = Left(ringnummer, Len(ringnummer) - 5) nynr = Right(ringnummer, 5)
If nybog = glbog Then If nynr = glnr + 1 Then glnr = nynr glbog = nybog Else rst2.MoveLast rst2.Edit rst2!ringnrslut = glbog & CStr(glnr) rst2.Update glnr = nynr glbog = nybog rst2.AddNew rst2!ringnrstart = nybog & CStr(nynr) rst2.Update End If Else rst2.MoveLast rst2.Edit rst2!ringnrslut = glbog & CStr(glnr) rst2.Update rst2.AddNew rst2!ringnrstart = nybog & CStr(nynr) rst2.Update
If nynr = glnr + 1 Then glnr = nynr glbog = nybog Else rst2.MoveLast rst2.Edit rst2!ringnrslut = glbog & CStr(glnr) rst2.Update glnr = nynr glbog = nybog End If End If rst.MoveNext Loop rst2.MoveLast rst2.Edit rst2!ringnrslut = glbog & CStr(glnr) rst2.Update rst2.MoveFirst End If rst.Close rst2.Close db.Close End Function
''''''''''''kode slut'''''''''''''''''
Skulle nogen have forslag til forbedringer eller forslag til mere elegant kodning hører jeg meget gerne nærmere.
VH AZ
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
