Avatar billede Klaus123 Mester
13. november 2018 - 10:23 Der er 1 løsning

Optimering af kode

Hej

Jeg er ny i vba og skal have nedenstående kode til at køre hurtigere. Jeg håber der er nogen som vil komme med input.

Option Explicit




Sub Sub_forrige_periode()




Application.ScreenUpdating = False

Dim Faggrupper As Variant 'Vektor med faggruppe
Dim Faggruppe As Variant 'Aktuelt ark

Dim sht As Worksheet
Dim LastRow As Long
Dim FirstRow As Integer


Dim n As Integer 'Første synlige række efter de skjulte rækker
Dim i As Integer 'Første kolonne med sagsdata

Dim startColumn As Integer
Dim endColumn As Integer

'Laver vektorer
Faggrupper = Array("Arkitekt", "Ingeniør" , "Konstruktør", "EogK", "VogA", "Byplan", "Bygherrerådgivning", "Byggeleder", "Brand", "El") 'Laver vektor med faggrupper


For Each Faggruppe In Faggrupper
Sheets(Faggruppe).Select

Set sht = ActiveSheet
n = 0
Do
    n = n + 1
Loop Until Cells(1, 7 + n).EntireColumn.Hidden = False 'Finder første skjulte kolonne efter række 6

'Viser første uge en uge tidligere
startColumn = n + 6

endColumn = n + 31

Range(Cells(, startColumn), Cells(, startColumn)).EntireColumn.Hidden = False


'Viser sidste uge en uge tidligere


Range(Cells(, endColumn + 1), Cells(, endColumn + 1)).EntireColumn.Hidden = True

LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

FirstRow = Range("A:A").Find(what:="PL", after:=Range("A1")).Row + 1

'Indsætter formel i kolonne F mellem række 25 og LastRow
For i = FirstRow To LastRow
    Cells(i, 6).FormulaR1C1 = "=SumVisible(RC[2]:RC[311])"
Next i

   
'Laver navne
'declare object variables to hold references to worksheet containing cell range, and cell range itself

    Dim myWorksheet As Worksheet
    Dim myNamedRange As Range
    'declare variable to hold defined name
    Dim myRangeName As String
   
   
    'identify worksheet containing cell range, and cell range itself
    Set myWorksheet = ThisWorkbook.Worksheets(Faggruppe)
   
    Set myNamedRange = myWorksheet.Range(Cells(4, startColumn), Cells(4, startColumn + 9))
    'specify defined name
    myRangeName = "Uger"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange

    Set myNamedRange = myWorksheet.Range(Cells(5, startColumn), Cells(5, startColumn + 9))
    'specify defined name
    myRangeName = "Kapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(6, startColumn), Cells(6, startColumn + 9))
    'specify defined name
    myRangeName = "Fri"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(7, startColumn), Cells(7, startColumn + 9))
    'specify defined name
    myRangeName = "NettoKapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(8, startColumn), Cells(8, startColumn + 9))
    'specify defined name
    myRangeName = "ArbejdeIndvUge"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
   
    Set myNamedRange = myWorksheet.Range(Cells(9, startColumn), Cells(9, startColumn + 9))
    'specify defined name
    myRangeName = "RestKapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
Next Faggruppe
   
Application.ScreenUpdating = True

End Sub
Avatar billede Max_P_Larsen Seniormester
14. november 2018 - 10:25 #1
Der er flere forskellige "tricks", du kan bruge for, at få din kode til at køre hurtigere.

1) Slå automatisk genberegning fra mens koden kører

Application.Calculation = xlCalculationManual (i starten af koden)

Application.Calculation = xlCalculationAutomatic (i slutningen af koden)

Derved bruger processoren ikke kræfter (og dermed tid) på at genberegne hver gang, din VBA-kode indsætter en formel.

2) Undgå at skabe loops/løkker, der skriver i en celle af gangen

Denne del af din kode er et eksempel herpå:

'Indsætter formel i kolonne F mellem række 25 og LastRow
For i = FirstRow To LastRow
    Cells(i, 6).FormulaR1C1 = "=SumVisible(RC[2]:RC[311])"
Next i

Når du allerede kender FirstRow og LastRow, og når cellerne i øvrigt skal have samme indhold/formel, er det hurtigere at skrive én gang i hele område i stedet for at skrive celle for celle i området.

    Cells(i, 6).Resize(LastRow - FirstRow + 1, 1).FormulaR1C1 = "=SumVisible(RC[2]:RC[311])"


Mvh Max
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester