Rangering af tabeller

Ring til mig (50573433).
Det kan være, at jeg kan hjælpe dig, men jeg bliver helt forvirret af din forklaring.
Peter

Du er velkommen til at sende filen/model. @-adresse under min profil.

Har set dit upload. Hvad mener du med følgende"" ""?:
"Løsningen med at sortere efter målopfyldelse er der, men da der er 250 tabeller og det ""sorteringen kan være forskellig fra gang til gang"" er det noget omstændigt."

Supertekst> Jeg mener at løsningen skal håndtere 250 selvstændige tabeller. Havde der kun været 1 ville jeg lave det manuelt fra gang til gang. Men når der er 250, stå tager det meget tid.
Rangeringen ændres hver måned, så det er en løsning der skal håndteres løbende, så en manuel løsning vil betyde 250 * 12 = 3000 rangeringer pr. år.

Tabeller betyder små overblik på 10 rækker med 5-10 kolonner.
Dvs. der typisk er 15 tabeller på et regneark.

Ok - det er ikke noget større problem at sortere et større antal via VBA - men det stiller følgende spørgsmål:

- er tabeller lige store - eller er der samme afstand mellem dem.
- d.v.s. at der er flere ark, der skal sorteres tabeller på.

Nej tabellerne er ikke lige store og har heller ikke samme afstand.

De er vidt forskellige alle 250.

Jeg tænkte om man kan navngive hver tabel og sorteringsområde og så bruge det i makroen.

På den måde sikre jeg mig at bliver der ændret i tabellen skal jeg ikke ændre i makroen.

Men hvordan?

Er i gang iflg. #6
Er målopfyldelsen altid sidste kolonne?

Nej. Det er typisk den 2. sidste.
Den sidste kolonne er i de fleste tilfælde en point kolonne - Størst point = størst målopfyldelse.

I ca. 10 tabeller er der en ekstra kolonne efter målopfyldelse og Point.

Tak - så må man kunne identificere målopfyldelse efter overskriften?

Jeg spurgte tidligere om de så skulle opfattes således, at tabellerne fordeler sig over flere ark? (#5)

PS: Det igangværende VBA ser lovende ud.

#5, ja der er ca. 30 ark og der er ikke samme størrelse.
Overskrift vil være fint!

Rem Anbringes i ThisWorkbook
Rem ========================
Public Sub sorteringAfTabeller()
Const sortOverskrift = "Målopfyldelse"

Dim nn As Name, arkNavn As String, ræk1 As Integer, rækX As Integer, antalKol As Integer, sortKol As Integer
    antalNavne = ActiveWorkbook.Names.Count
    Application.ScreenUpdating = False
   
    For Each nn In ActiveWorkbook.Names
Rem marker tabel
        arkNavn = isolerArkNavn(nn)
        ActiveWorkbook.Sheets(arkNavn).Select
       
        nn.RefersToRange.Select
        ræk1 = Selection.Row
        antalræk = Selection.Rows.Count
       
        rækX = ræk1 + antalræk - 1
        antalKol = Selection.Columns.Count
        sortKol = findSortKolonne(ræk1, antalKol, sortOverskrift)
       
        UdførSortering arkNavn, ræk1 + 1, rækX, antalKol, sortKol
    Next
End Sub
Private Sub UdførSortering(arkNavn, fraRæk, tilRæk, antalKol, sortKol)
    ActiveWorkbook.Worksheets(arkNavn).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(arkNavn).Sort.SortFields.Add Key:=Range(Cells(fraRæk + 1, sortKol), Cells(tilRæk, sortKol)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
       
    With ActiveWorkbook.Worksheets(arkNavn).Sort
        .SetRange Range(Cells(fraRæk, 1), Cells(tilRæk, antalKol))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Private Function findSortKolonne(ræk1, antalKol, overskrift)
Dim kol As Integer
    For kol = antalKol To 1 Step -1
        If Cells(ræk1 + 1, kol) = overskrift Then
            findSortKolonne = kol
            Exit Function
        End If
    Next kol
Rem ** Fejl ** Overskrift kan ikke identificeres
    Stop
End Function
Private Function isolerArkNavn(nn)
Dim wt As Variant, arkNavn As String
    wt = Split(nn, "!")
    arkNavn = Replace(wt(0), "=", "")
    arkNavn = Replace(arkNavn, "'", "")
    isolerArkNavn = arkNavn
End Function

Hejsa

Jeg har prøvet at teste og har følgende kommentarer:

- Jeg har svært ved at se om makroen sorterer alle tabellerne
- Den stopper ved "stop". Når jeg så prøver at starte den igen, så får jeg en fejl 400??
- Skal jeg indsætte den på alle ark? Kan den kører på alle ark på en gang, så jeg er fri for at starte den 30 gange?
- Jeg har i et andet spørgsmål uploaded en prøvefil: http://gupl.dk/709060/ - Her har jeg opslag. Jeg tror man bliver nødt til at indsætte hele arket som værdier for at få det til at virke.
- Kan du prøve at beskrive lidt mere hvad den gør - evt. som hjælpetekst i makroen

Hej

- VBA-koden indsættes i ThisWorkbook i VBA-vinduet (Alt+F11)
- Alle tabeller skal navngives
- Kolonne med Målopfyldelse skal have denne overskrift - kan den overskrift ikke findes - stopper processen

Du kan prøve at åbne VBA-vinduet og så "steppe" igennem koden med F8. I den første linje efter erklæringerne øverst =
"antalNavne = ActiveWorkbook.Names.Count"
kan du ved at pege på antalNavne aflæse det antal oprettede navne, der findes i filen.
Processen skal blot være nået til linjen efter denne.


Har en model der har tabeller på 2 ark - den kan du få hvis du sender en mail. @-adresse under min profil.

Hejsa

Følgende kommentarer:
- Du har indsat afdelingsnummer ud for hver tabel. Det er der ikke i "virkeligheden". Der står de kun en gang og så laves der opslag ud fra dem.
- Det betyder også at makroen ikke virker hos mig, da opslagene hele tiden modvirker rangeringen.
- Derfor er det nok nødvendigt at "kopier" og "indsætte som vædier" på de ark, hvor der er tabeller der skal rangeres.

Kan du rette det eller har du en anden ide?

Ok - har ikke været opmærksom på dette.
Ser om der er en vej udenom..

Tror ikke jeg kommer videre på nuværende grundlag.

Jeg kan sagtens leve med denne løsning ved at man kopier arkene og indsætter værdier.

MEN Jeg får en fejl om at jeg er Out of range. Hvad kan det betyde?
Det virker som om makroen slet ikke starter på at gå i gang. Kan det være fordi der er angivet 2 områder (tabeller) navngivet som lapper over de tabeller der skal rangeres?

Hvis der kommer en Debug knap - så prøv at aktivere denne se hvilke linje i VBA-koden den peger på.

Fejlen opstår når denne linje køres:
ActiveWorkbook.Sheets(arkNavn).Select

Fejlen er:

Runtime error '9':
Subscript out of range.

Jeg har fået koden til at søge efter "point" i stedet for "målopfyldelse". Det er rettet øverst:

Rem Anbringes i ThisWorkbook
Rem ========================
Public Sub sorteringAfTabeller()
Const sortOverskrift = "Point"


Kan det være det? Er der andre steder jeg skal rette det?

Prøv ar erstatte begyndelsen af koden med nedenstående:

Rem Anbringes i ThisWorkbook
Rem ========================
Public Sub sorteringAfTabeller()
Const sortOverskrift = "Point"

Dim nn As Name, arkNavn As String, ræk1 As Integer, rækX As Integer, antalKol As Integer, sortKol As Integer
On Error GoTo fejl

    antalNavne = ActiveWorkbook.Names.Count
    Application.ScreenUpdating = False
   
    For Each nn In ActiveWorkbook.Names
Rem marker tabel
        arkNavn = isolerArkNavn(nn)
       
        ActiveWorkbook.Sheets(arkNavn).Select
       
        nn.RefersToRange.Select
        ræk1 = Selection.Row
        antalræk = Selection.Rows.Count
       
        rækX = ræk1 + antalræk - 1
        antalKol = Selection.Columns.Count
        sortKol = findSortKolonne(ræk1, antalKol, sortOverskrift)
       
        UdførSortering arkNavn, ræk1 + 1, rækX, antalKol, sortKol
    Next
   
    Exit Sub

fejl:
    MsgBox "Navn: " & nn & " Arknavn: " & arkNavn
    Stop
End Sub

Prøv at erstatte bestående VBA i begyndelsen af koden med dette:

Public Sub sorteringAfTabeller()
Const sortOverskrift = "Point"

Dim nn As Name, arkNavn As String, ræk1 As Integer, rækX As Integer, antalKol As Integer, sortKol As Integer
On Error GoTo fejl

    antalNavne = ActiveWorkbook.Names.Count
    Application.ScreenUpdating = False
   
    For Each nn In ActiveWorkbook.Names
Rem marker tabel
        arkNavn = isolerArkNavn(nn)
       
        ActiveWorkbook.Sheets(arkNavn).Select
       
        nn.RefersToRange.Select
        ræk1 = Selection.Row
        antalræk = Selection.Rows.Count
       
        rækX = ræk1 + antalræk - 1
        antalKol = Selection.Columns.Count
        sortKol = findSortKolonne(ræk1, antalKol, sortOverskrift)
       
        UdførSortering arkNavn, ræk1 + 1, rækX, antalKol, sortKol
    Next
   
    Exit Sub

fejl:
    MsgBox "Navn: " & nn & " Arknavn: " & arkNavn
    Stop

Den skriver følgende i den msgBox du har indsat:
Navn: =#REF!REF! Arknavn: #REF

Hvad betyder det?

Prøv at se på de navne, der er oprettet.
Koden udtrækker arknavn af for de navne der er oprettet - idet dette indgår i definitionen af navnet: Ark Navn & område.

I nogle af tabelnavnene indgår ÆØÅ. Har det betydning?

Der var mellemrum og "-" i arknavnet. Det har jeg slettet mellemrum og "-". Det hjælper ikke.

ÆØÅ skulle ikke have nogen betydning

Det er i den sidste funktion arknavn uddrages:
Private Function isolerArkNavn(nn)
Dim wt As Variant, arkNavn As String
    wt = Split(nn, "!")
    arkNavn = Replace(wt(0), "=", "")
    arkNavn = Replace(arkNavn, "'", "")
    isolerArkNavn = arkNavn
End Function

Opdeler udtrykket for navnet efter "!"
Arknavn udtrækkes fra det første element i opdelingen
"=" erstattes af ""
"'" erstattes af ""

Det er vist hvad jeg kan oplyse.

Forstår ikke hvad du mener.. :-(

Kan du forklare hvad jeg evt. kan gøre?

Har ikke noget forslag - ved ikke hvad det er for et navn.

Opgave lukket - virker ikke