reorganisering af et data

Efter ser lidt misvisende ud.
postnumrene skal selvfølgelig stå under hinanden og tilsvarende med navnene. Det er rokaden af bestillingerne jeg er ude efter. Formålet er at mindske antallet af linier, så det bliver mere overskueligt.

Forslag: koden anbringes i aktuelle ark

Rem Data forventes sorteret efter postnr
Rem ====================================
Rem Reorganiserede data indsættes fra kolonne E
Const startRæk = 1                                  'kan modificeres
Const startKol = 5                                  '-"-
Dim rKol, rRæk
Dim postnr, navn As String, nr
Sub reOrganisering()
    postnr = 0
    navn = ""
    rRæk = startRæk
    rKol = startKol                                  'kol E
   
    Application.ScreenUpdating = False
   
    For ræk = startRæk To 65000
        If Cells(ræk, 1) = "" Then
            Exit For
        End If
       
        If ræk = startRæk Then
            nytpostnr ræk
            indsætNavn ræk
            indsætNr ræk
        Else
Rem samme postnr + navn
            If Cells(ræk, 1) = postnr Then
                If Cells(ræk, 2) = navn Then
                    indsætNr ræk
                Else
                    rRæk = rRæk + 1
                    rKol = startKol + 1
                    indsætNavn ræk
                    indsætNr ræk
                End If
            Else
Rem nyt postnr
                rRæk = rRæk + 1
                rKol = startKol
                nytpostnr ræk
                indsætNavn ræk
                indsætNr ræk
            End If
        End If
    Next ræk
   
    Application.ScreenUpdating = True

    MsgBox ("Reorganisering afsluttet")
End Sub
Private Sub nytpostnr(ræk)
    postnr = Cells(ræk, 1)
    Cells(rRæk, rKol) = postnr
    rKol = rKol + 1
End Sub
Private Sub indsætNavn(ræk)
    navn = Cells(ræk, 2)
    Cells(rRæk, rKol) = navn
    rKol = rKol + 1
End Sub
Private Sub indsætNr(ræk)
    nr = Cells(ræk, 3)
    Cells(rRæk, rKol) = nr
    rKol = rKol + 1
End Sub

Hej Supertekst
Det ser rigtigt godt ud :O)).
Kan jeg få dig til at justere lidt på koden?
Jeg har brug for at koden kan afvikles fra et modul i stedet for fra det enkelte ark. Samtidig vil det være fint, om der kan indsættes et tom linie før hvert postnummmer. Kunne det gøres ved at adressen gemmes i et array, som efterfølgende bruges til at indsætte den tomme linie (metoden mest for at jeg gerne vil lære at anvende den). Kan du gemme indholdet af nr i en variabel som tæller op. Jeg har brug for at kende det største antal bestillinger på et navn.
mvh.
Richter

Hej richter1

Det "hele" kan gemmes i et array før selve udskrivningen - er det det du er interesseret i?

"Største antal bestillinger" - skal det optælles som sum pr. navn - eller?

ja, meget, da det vil gøre det mere flexibelt, især da jeg kan for vente at mine brugere på et senere tidspunkt vil ønske at flere felter tages med fra databaseudtrækket.

Til det sidste spørgsmål. jeg skal bruge det største antal bestillinger pr. navn. Ud fra eksemplet i mit spørgsmål vil det være hansen med 3 bestillinger. evt. kunne der laves en kolonne hvor antal bestillinger tælles sammen.

Her er version2 - ikke med arrays (endnu) men med tom række før nyt postnr og optælling af antal bestillinger.

Rem Version 2
Rem Koden anbringes i et Module
Rem Data forventes sorteret efter postnr
Rem ====================================
Rem Reorganiserede data indsættes fra kolonne E
Rem Antal bestillinger vises efter kolonnen med Navn
Rem ================================================
Const startRæk = 1                                  'kan modificeres
Const startKol = 5                                  '-"-
Dim rKol, rRæk
Dim postnr, navn As String, nr
Sub reOrganisering()
    postnr = 0
    navn = ""
    rRæk = startRæk
    rKol = startKol                                  'kol E
   
    Application.ScreenUpdating = False
   
    For ræk = startRæk To 65000
        If Cells(ræk, 1) = "" Then
            Exit For
        End If
       
        If ræk = startRæk Then
            nytpostnr ræk
            indsætNavn ræk
            indsætNr ræk
        Else
Rem samme postnr + navn
            If Cells(ræk, 1) = postnr Then
                If Cells(ræk, 2) = navn Then
                    indsætNr ræk
                Else
                    rRæk = rRæk + 1
                    rKol = startKol + 1
                    indsætNavn ræk
                    indsætNr ræk
                End If
            Else
Rem nyt postnr
                rRæk = rRæk + 1
                rKol = startKol
                nytpostnr ræk
                indsætNavn ræk
                indsætNr ræk
            End If
        End If
    Next ræk
   
    Columns.AutoFit
    Application.ScreenUpdating = True

    MsgBox ("Reorganisering afsluttet")
End Sub
Private Sub nytpostnr(ræk)
Rem Hvis ikke start-rækken - så "linieskift"
    If ræk > startRæk Then
        rRæk = rRæk + 1
    End If
   
    postnr = Cells(ræk, 1)
    Cells(rRæk, rKol) = postnr
    rKol = rKol + 1
End Sub
Private Sub indsætNavn(ræk)
    navn = Cells(ræk, 2)
    Cells(rRæk, rKol) = navn
   
Rem klargør celle til optælling
    Cells(rRæk, startKol + 2) = 0
    Cells(rRæk, startKol + 2).Font.Bold = True
   
    rKol = rKol + 2
End Sub
Private Sub indsætNr(ræk)
    nr = Cells(ræk, 3)
    Cells(rRæk, rKol) = nr
    rKol = rKol + 1
   
Rem Optæl antal bestillinger
    Cells(rRæk, startKol + 2) = Cells(rRæk, startKol + 2) + 1
End Sub

Det eneste jeg mangler er nu at få gemt den største værdi af antal bestillinger i en variabel. Ellers er det helt perfekt :O))

Ja - det glemte jeg.
Spørgsmål: er det kun den største af alle og ikke hvem - eller er det et array med alle og deres antal?

Da jeg ikke har meget erfaring med et array, så vil jeg gerne have indlæst antal bestilliger i et array, hvis jeg efterfølgende kan finde det største antal bestilligner.

Får du tid til at løse selve opgaven via et array? det vil være godt for den senere udvikling af opgaven.

Vi fortsætter lige dialogen i morgen....

Hermed version 3 med Max-variabler.
Vedr. array - så er det nødvendigvis ikke løsningen for fremtidens behov. Derimod bestemmer antallet af kolonner, der måtte komme i den enkelte række, hvor mange felter, der skal arbejdes med. Løsningen må så være at programmet taget højde for dette og opsætter felter kolonnevis - hvor visse felter har en for programmet kendt betydning. Men lad os evt. vende tilbage til det på et eller andet tidspunkt.

Rem Version 3
Rem Koden anbringes i et Module
Rem Data forventes sorteret efter postnr
Rem ====================================
Rem Reorganiserede data indsættes fra kolonne E
Rem Antal bestillinger vises efter kolonnen med Navn
Rem ================================================
Const startRæk = 1                                  'kan modificeres
Const startKol = 5                                  '-"-
Dim rKol, rRæk
Dim postnr, navn As String, nr

Rem Variabler med maksimum antal bestillinger      '<--- *** MAX VARIABLER ***
Public maxAntal As Integer, maxNavn As String, maxPostnr As Integer
Rem =========================================
Sub reOrganisering()
    postnr = 0
    navn = ""
    maxAntal = 0
    maxNavn = ""
    maxPostnr = 0
   
    rRæk = startRæk
    rKol = startKol                                  'kol E
   
    Application.ScreenUpdating = False
   
    For ræk = startRæk To 65000
        If Cells(ræk, 1) = "" Then
            Exit For
        End If
       
        If ræk = startRæk Then
            nytpostnr ræk
            indsætNavn ræk
            indsætNr ræk
        Else
Rem samme postnr + navn
            If Cells(ræk, 1) = postnr Then
                If Cells(ræk, 2) = navn Then
                    indsætNr ræk
                Else
                    rRæk = rRæk + 1
                    rKol = startKol + 1
                    indsætNavn ræk
                    indsætNr ræk
                End If
            Else
Rem nyt postnr
                rRæk = rRæk + 1
                rKol = startKol
                nytpostnr ræk
                indsætNavn ræk
                indsætNr ræk
            End If
        End If
    Next ræk
   
    Columns.AutoFit
    Application.ScreenUpdating = True

    MsgBox ("Reorganisering afsluttet")
End Sub
Private Sub nytpostnr(ræk)
Rem Hvis ikke start-rækken - så "linieskift"
    If ræk > startRæk Then
        rRæk = rRæk + 1
    End If
   
    postnr = Cells(ræk, 1)
    Cells(rRæk, rKol) = postnr
    rKol = rKol + 1
End Sub
Private Sub indsætNavn(ræk)
    navn = Cells(ræk, 2)
    Cells(rRæk, rKol) = navn
   
Rem klargør celle til optælling
    Cells(rRæk, startKol + 2) = 0
    Cells(rRæk, startKol + 2).Font.Bold = True
   
    rKol = rKol + 2
End Sub
Private Sub indsætNr(ræk)
    nr = Cells(ræk, 3)
    Cells(rRæk, rKol) = nr
    rKol = rKol + 1
   
Rem Optæl antal bestillinger
    Cells(rRæk, startKol + 2) = Cells(rRæk, startKol + 2) + 1
   
Rem Gem største antal
    If Cells(rRæk, startKol + 2) > maxAntal Then
        maxAntal = Cells(rRæk, startKol + 2)
        maxNavn = Cells(rRæk, startKol + 1)
        maxPostnr = postnr
    End If
End Sub

Når jeg afvikler koden og vil have udskrevet variablen maxantal, så er variablen tom. Det jeg gerne vil have er, at når koden er afviklet så har jeg indholdet af maxantal tilrådighed. Som den er nu, så er den tom, når koden er afsluttet. Er det ikke sådan at når rutinen indsætnr forlades, så nulstilles variablerne?

Maxantal skal fanges af evt. en anden koden inden koden afsluttes - derfor er alle max-variablerne Public - alternativt overføres til et andet Ark/Fil.

Indholdet af mxantal udskrevet i en celle indeholder ikke det største antal bestillinger en person har foregtaget, den indholder det antal bestillinger som personen i sidste linie har bestit - eller har jeg misforstået noget?

Det er nok mig der har misforstået noget - det skal være summen af antal?

Nye version - nu med 2 moduler:
Start kørsel i Module2
===============================

Rem Module2 - start her
Dim maxAntal
Sub start()
    Module1.reOrganisering
   
Rem hent max anta1 fra module1
    maxAntal = Module1.maxAntal
    Stop
End Sub

---------------------------------------

Rem Module1
Rem =======
Rem Version 4
Rem Koden anbringes i et Module
Rem Data forventes sorteret efter postnr
Rem ====================================
Rem Reorganiserede data indsættes fra kolonne E
Rem Antal bestillinger vises efter kolonnen med Navn
Rem ================================================
Const startRæk = 1                                  'kan modificeres
Const startKol = 5                                  '-"-
Dim rKol, rRæk
Dim postnr, navn As String, nr

Rem Variabler med maksimum antal bestillinger      '<--- *** MAX VARIABLER ***
Dim akkAntal As Integer
Public maxAntal As Integer, maxNavn As String, maxPostnr As Integer
Rem =========================================
Sub reOrganisering()
    postnr = 0
    navn = ""
   
    akkAntal = 0
    maxAntal = 0
   
    rRæk = startRæk
    rKol = startKol                                  'kol E
   
    Application.ScreenUpdating = False
   
    For ræk = startRæk To 65000
        If Cells(ræk, 1) = "" Then
            Exit For
        End If
       
        If ræk = startRæk Then
            nytpostnr ræk
            indsætNavn ræk
            indsætNr ræk
        Else
Rem samme postnr + navn
            If Cells(ræk, 1) = postnr Then
                If Cells(ræk, 2) = navn Then
                    indsætNr ræk
                Else
                    If ræk > startRæk Then
                        akkAntal = 0
                    End If
                   
                    rRæk = rRæk + 1
                    rKol = startKol + 1
                    indsætNavn ræk
                    indsætNr ræk
                End If
            Else
Rem nyt postnr
                akkAntal = 0
                rRæk = rRæk + 1
                rKol = startKol
                nytpostnr ræk
                indsætNavn ræk
                indsætNr ræk
            End If
        End If
    Next ræk
   
    Columns.AutoFit
    Application.ScreenUpdating = True

    MsgBox ("Max Antal: " & CStr(maxAntal) & " " & maxNavn & " " & CStr(maxPostnr))
End Sub
Private Sub nytpostnr(ræk)
Rem Hvis ikke start-rækken - så "linieskift"
    If ræk > startRæk Then
        rRæk = rRæk + 1
    End If
   
    postnr = Cells(ræk, 1)
    Cells(rRæk, rKol) = postnr
    rKol = rKol + 1
End Sub
Private Sub indsætNavn(ræk)
    navn = Cells(ræk, 2)
    Cells(rRæk, rKol) = navn
   
Rem klargør celle til optælling
    Cells(rRæk, startKol + 2) = 0
    Cells(rRæk, startKol + 2).Font.Bold = True
   
    rKol = rKol + 2
End Sub
Private Sub indsætNr(ræk)
    nr = Cells(ræk, 3)
    Cells(rRæk, rKol) = nr
    rKol = rKol + 1
   
Rem Optæl antal bestillinger
    Cells(rRæk, startKol + 2) = Cells(rRæk, startKol + 2) + 1
   
Rem optæl antal - check om størst
    akkAntal = akkAntal + nr
    If akkAntal > maxAntal Then
        maxAntal = akkAntal
        maxNavn = Cells(rRæk, startKol + 1)
        maxPostnr = postnr
    End If
End Sub

Jeg får en fejl i rutinen: Privat Sub indsætNr(ræk)
 
i linien: akkAntal = akkAntal + nr

Det er en run-time error(6) - siger det dig noget?

Det er overflow - har du mulighed for sende din fil til: pb@supertekst-it.dk

PS: Prøv at rette følgende i de to moduler Integer --> Long i linierne '+++

Module1:

Rem Variabler med maksimum antal bestillinger      '<--- *** MAX VARIABLER ***
Dim akkAntal As Long  '+++
Public maxAntal As Long, maxNavn As String, maxPostnr As Integer '+++

Module2:
Rem Module2 - start her
Dim maxAntal as Long  '+++
Sub start()
    Module1.reOrganisering

Den fejler stadig men ikke samme sted. Datafil afsendt.

Efter at have modtaget "virkelige data" blev følgende justeret:
Public maxAntal As Long, maxNavn As String, maxPostnr As String

, hvor maxPostnr blev ændret fra Integer

Tak for hjælpen - en flot løsning :OO)