Opprette faner automatisk – og finne faner enkelt

Opprette faner automatisk – og finne faner enkelt

De som liker å splitte opp data i mange faner, bruker tid på å f.eks opprette de tolv nye fanene de trenger for å registrere salg, timer eller hva det måtte være. I tillegg skal fanene gjerne stå i riktig rekkefølge – og ikke minst – man skal kunne finne tilbake til fanene i etterkant.

Les også: Om å velge Trøbbel eller Easypeasy når du legger inn data i Excel

I dette eksemplet følger det med to rutiner du kan ha nytte av:

• Rutinen OpprettFaner, som oppretter faner for år og måneder med et knappetrykk.
• Rutinen SortereFaner, som sorterer fanene i stigende rekkefølge

(Artikkelen fortsetter under videoruten)

Finne faner enkelt

Det er en litt hemmelig funksjon for å slå opp fanene i Excel. Nede i venstre hjørne kan du høyreklikke mellom de to pilene vi benytter for å bla i faner. Da får du opp et vindu hvor du kan velge faner fra en liste. Det er enkelt, det 🙂

Les også: Velge fane ved oppstart automatisk

Under har du de to rutinene som programmet benytter.

Subrutinen OpprettFaner

Denne rutinen opprette faner automatisk – hvis de ikke finnes fra før. Input henter fra definerte celler i fanen Parametre.

Sub OpprettFaner()
   Dim WS As Worksheet
   Dim PAR As Worksheet
   Dim MAL As Worksheet
   Dim SH As Worksheet
   
   Dim MalNavn As String
   Dim FaneNavn As String
   
   Dim Maaned As Long
   Dim Aar As Long
   
   Dim FraAar As Long
   Dim TilAar As Long
   Dim SkilleTegn As String
   Dim FraMnd As Long
   Dim TilMnd As Long
   
   Dim sSheets As String
   Dim PreFix As String
   
   Set PAR = Sheets("Parametre")
      
   'Hent informasjon om fanene som skal opprettes
   With PAR
    FraAar = .Cells(1, 2)
    TilAar = .Cells(2, 2)
    SkilleTegn = .Cells(3, 2)
    FraMnd = .Cells(4, 2)
    TilMnd = .Cells(5, 2)
    PreFix = .Cells(6, 2)
    MalNavn = Trim(.Cells(7, 2))
   End With
   
   'Sett malark hvis dette er angitt
   If MalNavn <> "" Then
    Set MAL = Sheets(MalNavn)
   End If
   
   'Finn eksisterende ark i boken og lage en streng av dem
   sSheets = "\"
   For Each SH In ThisWorkbook.Sheets
    sSheets = sSheets & SH.Name & "\"
   Next
   
   'Loop igjennom årene
   For Aar = FraAar To TilAar
    
    'Loop i gjennom månedene
    For Maaned = FraMnd To TilMnd
     
     'Formater faneneavnet som åååå.mm
     FaneNavn = PreFix & Aar & SkilleTegn & Format(Maaned, "00")
     
     If InStr(1, UCase(sSheets), "\" & UCase(FaneNavn) & "\") = 0 Then
     
     'Lag et nytt ark hvis mal ikke er angitt
     If MAL Is Nothing Then
      Set WS = Sheets.Add(Before:=PAR)
      WS.Name = FaneNavn
     Else
      'Eller lag kopi av malen
      MAL.Copy Before:=PAR
      ActiveSheet.Name = FaneNavn
     End If
     
     End If
     
    Next Maaned
   
   Next Aar
   
   SortereFaner
   
End Sub

Subrutinen SortereFaner

Denne rutinen sorterer fanene i arket i riktig rekkefølge. Hvis du vil bruke den i din egen arbeidsbok, kan du fjerne de fire linjene fra og med ‘Flytt MAL sist. Disse er spesifikke for eksempelarket.

Sub SortereFaner()

    Dim SHNavn As Collection
    Dim x As Long
    Dim y As Long
    Dim temp As String
    Dim SH As Worksheet

    Set SHNavn = New Collection

    'Legg arkene i samlingen
    For Each SH In ThisWorkbook.Worksheets
        SHNavn.Add SH.Name, SH.Name
    Next SH

    'Boblesortering
    For x = 1 To SHNavn.Count - 1
        For y = x + 1 To SHNavn.Count
            If SHNavn(x) > SHNavn(y) Then
               temp = SHNavn(y)
               SHNavn.Remove y
               SHNavn.Add temp, temp, x
            End If
        Next y
    Next x

   'Flytt arkene i stigende rekkefølge
   For x = SHNavn.Count - 1 To 1 Step -1
       Sheets(SHNavn(x)).Move Before:=Sheets(1)
   Next x

   'Flytt MAL sist
    Sheets("MAL").Move after:=Sheets(Sheets.Count)
   'Og så parametre helt til slutt
    Sheets("Parametre").Move after:=Sheets(Sheets.Count)

End Sub

Last ned regnearket her: OpprettFaner.xlsm (229 downloads )