Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Speed question
I have a spreadsheet to calculate building cost. In order
to produce a decent printout i want to find the automatic pagebreaks, see if they are anywhere near a heading, and move them if needed. My problem is it takes about 7s to finish. Is there a way to make it faster. Here's the code: Sub CheckSideSkift() Dim x, lRaekkeNr As Long Dim sStartCelle, sUdskriftsOmraade As String StartTid = Time Application.ScreenUpdating = False FjernSideSkift sStartCelle = ActiveCell.Address 'Cells.PageBreak = xlpagebreaknone 'Finder sidste række i kalkulation Range("d65536").Select Selection.End(xlUp).Select lRaekkeNr = Selection.Row 'Laver udskriftsområde sUdskriftsOmraade = "A2:" & "J" & lRaekkeNr ActiveSheet.PageSetup.PrintArea = sUdskriftsOmraade 'Løber alle rækker i regnearket igennem For x = 17 To lRaekkeNr 'Cells(x, 2).Select '(0) Checker for automatisk sideskift If Rows(x).PageBreak = xlPageBreakAutomatic Then 'Cells(x, 3).Select '------------------------------------------------- ----- '(1) Checker om rækken indeholder overskrift i kolonne 1 If Cells(x, 1).Font.Bold = True Then GoTo SlutCheck End If '(1) '------------------------------------------------- ----- '(2) Checker om rækken eller rækken over indeholder overskrift If Cells(x, 2).Font.Bold = True Then If Cells(x - 1, 1).Font.Bold = True Then Rows(x - 1).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(2) '------------------------------------------------- ----- '(3) Checker om rækken over eller rækken 2 over indeholder overskrift If Cells(x - 1, 2).Font.Bold = True Then If Cells(x - 2, 1).Font.Bold = True Then Rows(x - 2).PageBreak = xlPageBreakManual GoTo SlutCheck Else Rows(x - 1).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(3) '------------------------------------------------- ----- '(4) Checker om rækken 2 over eller rækken 3 over indeholder overskrift If Cells(x - 2, 2).Font.Bold = True Then If Cells(x - 3, 1).Font.Bold = True Then Rows(x - 3).PageBreak = xlPageBreakManual GoTo SlutCheck Else Rows(x - 2).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(4) '------------------------------------------------- ----- '(5) Checker om der er 2 eller flere linier på næste side If Cells(x, 3).Value = 0 Then GoTo SlutCheck Else If Cells(x + 1, 3).Value = 0 Then Cells(x, 2).Select Selection.End(xlUp).Select If Selection.Offset(-1, -1).Font.Bold = True Then Rows(Selection.Offset(-1, - 1).Row).PageBreak = xlPageBreakManual Else Rows(Selection.Row).PageBreak = xlPageBreakManual End If End If End If '(5) End If '(0) SlutCheck: Next Range(sStartCelle).Select Application.ScreenUpdating = True SlutTid = Time tid = (SlutTid - StartTid) * 24 * 3600 MsgBox tid End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA Speed question
Hi Lars,
First, you don't need to .select all the time. Selecting cells *really* slows down the code. Reference the cells directly instead, for example lRaekkeNr = Range("d65536").End(xlUp).Row is the same as Range("d65536").Select Selection.End(xlUp).Select lRaekkeNr = Selection.Row Second, you may gain some speed by looping through the HPageBreaks collection instead of examining every cell. I haven't tried it and I guess it depends on the amount of data if it's worth implementing. Best regards, Anders Silvén "Lars Kofod" skrev i meddelandet ... I have a spreadsheet to calculate building cost. In order to produce a decent printout i want to find the automatic pagebreaks, see if they are anywhere near a heading, and move them if needed. My problem is it takes about 7s to finish. Is there a way to make it faster. Here's the code: Sub CheckSideSkift() Dim x, lRaekkeNr As Long Dim sStartCelle, sUdskriftsOmraade As String StartTid = Time Application.ScreenUpdating = False FjernSideSkift sStartCelle = ActiveCell.Address 'Cells.PageBreak = xlpagebreaknone 'Finder sidste række i kalkulation Range("d65536").Select Selection.End(xlUp).Select lRaekkeNr = Selection.Row 'Laver udskriftsområde sUdskriftsOmraade = "A2:" & "J" & lRaekkeNr ActiveSheet.PageSetup.PrintArea = sUdskriftsOmraade 'Løber alle rækker i regnearket igennem For x = 17 To lRaekkeNr 'Cells(x, 2).Select '(0) Checker for automatisk sideskift If Rows(x).PageBreak = xlPageBreakAutomatic Then 'Cells(x, 3).Select '------------------------------------------------- ----- '(1) Checker om rækken indeholder overskrift i kolonne 1 If Cells(x, 1).Font.Bold = True Then GoTo SlutCheck End If '(1) '------------------------------------------------- ----- '(2) Checker om rækken eller rækken over indeholder overskrift If Cells(x, 2).Font.Bold = True Then If Cells(x - 1, 1).Font.Bold = True Then Rows(x - 1).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(2) '------------------------------------------------- ----- '(3) Checker om rækken over eller rækken 2 over indeholder overskrift If Cells(x - 1, 2).Font.Bold = True Then If Cells(x - 2, 1).Font.Bold = True Then Rows(x - 2).PageBreak = xlPageBreakManual GoTo SlutCheck Else Rows(x - 1).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(3) '------------------------------------------------- ----- '(4) Checker om rækken 2 over eller rækken 3 over indeholder overskrift If Cells(x - 2, 2).Font.Bold = True Then If Cells(x - 3, 1).Font.Bold = True Then Rows(x - 3).PageBreak = xlPageBreakManual GoTo SlutCheck Else Rows(x - 2).PageBreak = xlPageBreakManual GoTo SlutCheck End If End If '(4) '------------------------------------------------- ----- '(5) Checker om der er 2 eller flere linier på næste side If Cells(x, 3).Value = 0 Then GoTo SlutCheck Else If Cells(x + 1, 3).Value = 0 Then Cells(x, 2).Select Selection.End(xlUp).Select If Selection.Offset(-1, -1).Font.Bold = True Then Rows(Selection.Offset(-1, - 1).Row).PageBreak = xlPageBreakManual Else Rows(Selection.Row).PageBreak = xlPageBreakManual End If End If End If '(5) End If '(0) SlutCheck: Next Range(sStartCelle).Select Application.ScreenUpdating = True SlutTid = Time tid = (SlutTid - StartTid) * 24 * 3600 MsgBox tid End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Question on Calculation Speed | Excel Discussion (Misc queries) | |||
vlookup speed question | Excel Worksheet Functions | |||
Can you speed UP drag speed? | Excel Discussion (Misc queries) | |||
Re-calc. speed question | Excel Worksheet Functions | |||
I need mor Speed!!!! | Excel Discussion (Misc queries) |