[Løst] Redigering av makro

[Trelkrok]

Hei!

Denne makoen fungerer men går noe urolig (virker som jobber litt tungt)

Er det noe som kan fjernes i denne makroen uten å påvirke jobben den skal gjøre?

 

På forhånd takk 

 

Sub Overfoer()

 

    ActiveSheet.Unprotect

    Sheets("Bokføring").Select

    ActiveSheet.Unprotect

    Sheets("Faktura").Select

    Range("B7:C7").Select

 

Dim Src As Worksheet 'innskrivningsark

 

Dim Trg As Worksheet 'ark det overføres til

 

Dim Rsrc As Long 'rad det overføres fra

 

Dim Rtrg As Long 'rad det skrives til

 

Dim C As Long

 

Set Src = ThisWorkbook.Sheets("Faktura") 'endre til rett arknavn

 

Set Trg = ThisWorkbook.Sheets("Bokføring") 'endre denne også

 

Rows("63:63").Select

    Selection.Copy

    Sheets("Bokføring").Select

    Range("A2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Sheets("Faktura").Select

 

 

Rsrc = ActiveCell.Row 'A2

 

Rtrg = Trg.Cells(Trg.Rows.Count, 1).End(xlUp).Row + 1 'ledig rad under

 

For C = 1 To 60 'kolonne A tom AW

 

    Trg.Cells(Rtrg, C).Value = Src.Cells(Rsrc, C).Value

            

    Next

 

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Bokføring").Select

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Faktura").Select

    Range("B7:C7").Select

    ActiveWindow.SmallScroll Down:=-24

    

 

End Sub

 

[Harald Staff]

Det er litt avhengig av miljøet og hva regnearkene dine består av.

 

Men tre ting å starte med. Etter hver gang du skifter ark eller område, select, activate, putt en linje

DoEvents

umiddelbart etterpå. Det betyr "lytt til operativsystemet", som igjen betyr vent, ikke fortsett før dette er helt i orden. Man får aldri nok DoEvents i Excelkode, bare pøs på.

 

Så er det et par ting som kan øke ytelsen dramatisk hvis du jobber i et ark med mange eller tunge formler eller visualiseringer og betinget formatering og sånt. Det er å slå av at Excel skal regne om ved hver eneste celleendring:

 

Application.Calculation = xlCalculationManual

 

og å slå av at vi ser hva som skjer:

 

Application.Screenupdating = False

 

Husk for all del å sette disse tilbake til normalen ved kodeslutt eller i feilhåndtering. Folk blir lett urolige når regneark slutter å regne.

 

HTH. Beste hilsen Harald

[Trelkrok]

Det er litt avhengig av miljøet og hva regnearkene dine består av.

 

Men tre ting å starte med. Etter hver gang du skifter ark eller område, select, activate, putt en linje

DoEvents

umiddelbart etterpå. Det betyr "lytt til operativsystemet", som igjen betyr vent, ikke fortsett før dette er helt i orden. Man får aldri nok DoEvents i Excelkode, bare pøs på.

 

Så er det et par ting som kan øke ytelsen dramatisk hvis du jobber i et ark med mange eller tunge formler eller visualiseringer og betinget formatering og sånt. Det er å slå av at Excel skal regne om ved hver eneste celleendring:

 

Application.Calculation = xlCalculationManual

 

og å slå av at vi ser hva som skjer:

 

Application.Screenupdating = False

 

Husk for all del å sette disse tilbake til normalen ved kodeslutt eller i feilhåndtering. Folk blir lett urolige når regneark slutter å regne.

 

HTH. Beste hilsen Harald

Hei og takk for svar   

Skal se på dette etter hvert.

 

Til orientering:

I fanen "Faktura" har jeg laget en linje (Row63) med opplysninger fra selve Fakturaen som jeg vil ha med i bokføringen.

 

Denne  kopieres over i første ledige rad i fanen "Bokføring" med start i A2

 

Det ligger ingen betinget formatering eller tunge formler her, de ligger i selve Fakturaen og i en annen fane "Statestikk" som henter informasjon fortløpende fra bokføringsfanen.

 

Hvis jeg legger inn Application.Calculation = xlCalculationManual

hva vil slå denne på igjen?

 

Application.Screenupdating = False  er vel bare og endre til True

 

Mvh

RA

[Harald Staff]

Jeg beklager ufullstendig svar. Du setter det tilbake ved xlCalculationAutomatic. Her er litt detaljer

http://access-excel.tips/excel-vba-application-calculation-xlcalculationautomatic/

 

True er riktig antatt ja. Dette er en god sluttprosedyre, for Excel har ikke regnet mes sånn kode har kjørt:

 

Application.Calculation = xlCalculationAutomatic

Application.Screenupdating = True

DoEvents

Application.Calculate

DoEvents

 

Pass på at du havner her også hvis koden din feiler midtveis, ellers vil ikke damen regne. Sånt skjer ikke så sjeldent. Jeg har laget meg en egen makro "Reset Excel" som tilbakestiller alt. Den er i daglig bruk.

 

Beste hilsen Harald

[Trelkrok]

Jeg beklager ufullstendig svar. Du setter det tilbake ved xlCalculationAutomatic. Her er litt detaljer

http://access-excel.tips/excel-vba-application-calculation-xlcalculationautomatic/

 

True er riktig antatt ja. Dette er en god sluttprosedyre, for Excel har ikke regnet mes sånn kode har kjørt:

 

Application.Calculation = xlCalculationAutomatic

Application.Screenupdating = True

DoEvents

Application.Calculate

DoEvents

 

Pass på at du havner her også hvis koden din feiler midtveis, ellers vil ikke damen regne. Sånt skjer ikke så sjeldent. Jeg har laget meg en egen makro "Reset Excel" som tilbakestiller alt. Den er i daglig bruk.

 

Beste hilsen Harald

Hei, ingen ting og beklage det Harald. Fort gjort og glemme ting.

Skal legge ut fullstendig kode når jeg har fått den til. Alt går så mye bedre nå 

Godt å få hjelp av dere her inne   

Angående "Reset Excel" Dette hørtes VELDIG innteresangt og betryggende ut som alt annet du nevner.

Vært moro og sett denne 

 

Mvh

RA

[Trelkrok]

Hei igjen, dette ble SÅ MYE BEDRE at jeg samlet alle makroene på en operasjon ved og klikke på en knapp.

Før måtte jeg klikke på 3 knapper som også kunne være en feilkilde.

Hele denne koden ser sånn ut. Er det noe dere ser som kunne vært endret si gjerne ifra.

Ønsker alle en god helg. 

 

Sub Overfoer()

 

Application.ScreenUpdating = False 'skjule hva som skjer

Application.Calculation = xlCalculationManual 'Excel regner ikke ut

    ActiveSheet.Unprotect

    Sheets("Bokføring").Select

    ActiveSheet.Unprotect

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

DoEvents

 

Dim Src As Worksheet 'innskrivningsark

 

Dim Trg As Worksheet 'ark det overføres til

 

Dim Rsrc As Long 'rad det overføres fra

 

Dim Rtrg As Long 'rad det skrives til

 

Dim C As Long

 

Set Src = ThisWorkbook.Sheets("Pakkseddel") 'endre til rett arknavn

 

Set Trg = ThisWorkbook.Sheets("Bokføring") 'endre denne også

 

Rows("63:63").Select

    Selection.Copy

    Sheets("Bokføring").Select

    Range("A2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Sheets("Pakkseddel").Select

    

DoEvents

 

Rsrc = ActiveCell.Row 'A2

 

Rtrg = Trg.Cells(Trg.Rows.Count, 1).End(xlUp).Row + 1 'ledig rad under

 

For C = 1 To 60 'kolonne A tom AW

 

    Trg.Cells(Rtrg, C).Value = Src.Cells(Rsrc, C).Value

    

    DoEvents

    

    Next

 

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Bokføring").Select

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

    ActiveWindow.SmallScroll Down:=-24

DoEvents

  

 

 

 

'Lagre Pakkseddel

Dim Sti As String

Dim Filnavn As String

 

Sti = ActiveWorkbook.Path & "\"

Filnavn = "Pakkseddel_" & Cells(7, 6)

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        Sti & Filnavn, Quality:= _

        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

        OpenAfterPublish:=Aapne

DoEvents

 

'

    

 

'Gjøre klar til ny Pakkseddel

 

'

    ActiveSheet.Unprotect

    Sheets("Bokføring").Select

    ActiveSheet.Unprotect

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

Dim t As Integer

t = [J2] + 1

Range("j2").Value = t

 

'

    Range("B10:F10").Select

    Selection.ClearContents

    Range("K13").Select

    Selection.ClearContents

    Range("B18:B36").Select

    Selection.ClearContents

    Range("C18:C36").Select

    Selection.ClearContents

    Range("D18:D36").Select

    Selection.ClearContents

    Range("F44:F48").Select

    Selection.ClearContents

    Range("B7:C7").Select

'

DoEvents

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Bokføring").Select

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

    Sheets("Pakkseddel").Select

    Range("B7:C7").Select

  

     Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

Application.ScreenUpdating = True 'viser hva som skjer igjen

DoEvents

Application.Calculate

DoEvents

 

 ActiveWorkbook.Save

 

End Sub

Endret 8. juli 2016 av Trelkrok

[Harald Staff]

Fint at det funker. Da er resten bare pirk, eventuelt læring, det er ingenting man lærer mer av enn å lage noe en trenger.

 

Disse

 

    Range("B10:F10").Select

    Selection.ClearContents

 

kan du forkorte til

 

    Range("B10:F10").ClearContents

 

Jeg tror ikke du opplever merkbar økning av hastighet på en moderne maskin, det er mest snakk om stil og enkel, lesbar kode. Man skal i teorien aldri behøve Activate eller Select medmindre man driver med grafer, men det tar noen år å bli fortrolig med.

 

Apropos stil, jeg liker å få bekreftelse på at alt har gått bra eller hva som er gjort. Så la oss lage både det og feilhåndtering sammen. Endre dette

 

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

Til

 

Msgbox "Dette gikk da riktig fint :)"

Slutten:

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

og helt oppe i koden, ny linje etter Dim C As Long, setter du inn

 

On Error GoTo Slutten

 

Da blir det sånn at hvis du får en melding så har alt gått som det skal, hvis ikke har ett eller annet feilet og jobben er ikke gjort.

 

Reset Excel skal jeg ta i en egen tråd etterhvert. (Jeg har rota vekk en minnepinne med alt viktig på Roskilde Festival og må på kontoret til uka for å finne backup.)

 

Beste hilsen Harald

[Trelkrok]

Fint at det funker. Da er resten bare pirk, eventuelt læring, det er ingenting man lærer mer av enn å lage noe en trenger.

 

Disse

 

    Range("B10:F10").Select

    Selection.ClearContents

 

kan du forkorte til

 

    Range("B10:F10").ClearContents

 

Jeg tror ikke du opplever merkbar økning av hastighet på en moderne maskin, det er mest snakk om stil og enkel, lesbar kode. Man skal i teorien aldri behøve Activate eller Select medmindre man driver med grafer, men det tar noen år å bli fortrolig med.

 

Apropos stil, jeg liker å få bekreftelse på at alt har gått bra eller hva som er gjort. Så la oss lage både det og feilhåndtering sammen. Endre dette

 

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

Til

 

Msgbox "Dette gikk da riktig fint :)"

Slutten:

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

og helt oppe i koden, ny linje etter Dim C As Long, setter du inn

 

On Error GoTo Slutten

 

Da blir det sånn at hvis du får en melding så har alt gått som det skal, hvis ikke har ett eller annet feilet og jobben er ikke gjort.

 

Reset Excel skal jeg ta i en egen tråd etterhvert. (Jeg har rota vekk en minnepinne med alt viktig på Roskilde Festival og må på kontoret til uka for å finne backup.)

 

Beste hilsen Harald

Hei igjen, det må være moro og være så god på excel som enkelte her er 

Jeg skal se nærmere på dette Harald men nå må jeg ta meg av familien litt  Blir helt hekta på dette jeg 

Ha en fin kveld

 

RA

[Trelkrok]

Fint at det funker. Da er resten bare pirk, eventuelt læring, det er ingenting man lærer mer av enn å lage noe en trenger.

 

Disse

 

    Range("B10:F10").Select

    Selection.ClearContents

 

kan du forkorte til

 

    Range("B10:F10").ClearContents

 

Jeg tror ikke du opplever merkbar økning av hastighet på en moderne maskin, det er mest snakk om stil og enkel, lesbar kode. Man skal i teorien aldri behøve Activate eller Select medmindre man driver med grafer, men det tar noen år å bli fortrolig med.

 

Apropos stil, jeg liker å få bekreftelse på at alt har gått bra eller hva som er gjort. Så la oss lage både det og feilhåndtering sammen. Endre dette

 

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

Til

 

Msgbox "Dette gikk da riktig fint :)"

Slutten:

 Application.Calculation = xlCalculationAutomatic 'Slår påigjen utregning

 

og helt oppe i koden, ny linje etter Dim C As Long, setter du inn

 

On Error GoTo Slutten

 

Da blir det sånn at hvis du får en melding så har alt gått som det skal, hvis ikke har ett eller annet feilet og jobben er ikke gjort.

 

Reset Excel skal jeg ta i en egen tråd etterhvert. (Jeg har rota vekk en minnepinne med alt viktig på Roskilde Festival og må på kontoret til uka for å finne backup.)

 

Beste hilsen Harald

Hei igjen. 

Da har jeg endret det du påpeker men får en feil når jeg setter inn: "On Error GoTo Slutten"

I MsgBox ble det "Pakkseddel er opprettet :)"

Ellers går denne bra nå.

Ha en fin dag

 

RA

On Error GoTo Slutten