10. marts 2008 - 11:30Der er
6 kommentarer og 1 løsning
Nedskrivning af nummer og dato fra en mængde gentagende tal.
Jeg sidder med et ”stort” problem i Excel VBA, hvor jeg skal sortere nogle tal. Jeg har en lang række numre (ca. 17.000) hvor mange af dem går igen og op til over 100 gange. Jeg vil gerne have dem skrevet op så de kun optræder en gang. Da jeg ikke er vandt til at arbejde med VBA kan det godt være noget svært at få Sub’en til at gøre som jeg vil.
Der kan ses et eksempel på hvordan det skal se ud nederst.
Det kan være denne opgave er let for jer eksperter og hvis det er tilfældet så er der også en lille ekstraopgave hvis det skulle have interesse :-). Der er en datoer ud for hver nummer og første gang et nummer optræder skal der skrives en start dato (se tabel nedenunder), hvis nummeret optræder mere end en gang skal sidste dato skrives ud for slut.
I lang tid har samarbejdsbranchen fokuseret på at forbedre enhedsfunktioner – bedre kameraer, klarere lyd og smartere software. Men den virkelige forvandling handler ikke om funktioner.
Forslag - koden anbringes i Ark1: =================================
Dim antalRæk Dim ws As Worksheet, outpRæk, nr, fundetRæk Sub komprimeringAfNr() outpRæk = 2
Set ws = ActiveWorkbook.Sheets("Ark1") Rem beregn antal rækker antalRæk = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
Rem gennemløb af kolonne A With ws For ræk = 2 To antalRæk nr = .Cells(ræk, 1) dato = .Cells(ræk, 2)
Rem check om nr findes i forvejen Rem Output skrives i KOLONNERNE D=Nr. E=Start F=Slut Rem ================================================ fundetRæk = findesNrIoutput(nr) If fundetRæk > 0 Then .Cells(fundetRæk, 6) = dato Else .Cells(outpRæk, 4) = nr .Cells(outpRæk, 5) = dato .Cells(outpRæk, 6) = dato outpRæk = outpRæk + 1 End If Next ræk End With
MsgBox ("Komprimering af Nr. er udført") End Sub Private Function beregnAntalRækker(arkNavn) Set ws = ActiveWorkbook.Worksheets(arkNavn) beregnAntalRækker = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1 End Function Private Function findesNrIoutput(nr) Dim ræk With ws.Range("D2:D" & CStr(outpRæk)) Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then ræk = c.Row findesNrIoutput = ræk Else findesNrIoutput = 0 End If End With End Function
Det finder jeg ud af - det er ikke for lidt RAM. Det ville hjælpe, hvis du kunne sende de første 100 rækker fra din fil til: pb@supertekst-it.dk Jeg har kun testet med de data, som du har vist på Eksp.
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.
