06. juli 2001 - 12:45Der er
31 kommentarer og 1 løsning
Tung makro !!!!!!
Nedenstående makro hvis funktion består i følgende
1. Skjul rækker med med nul værdi 2. Udskriv 3. Vis rækker med nul værdi
Fungerer uden problemer første gang den bliver aktiveret, anden og efterfølgende gange er den helt ekstrem tung at danse med...hvorfor ??? :
Sub udskrivresultat5()
Sheets(\"RESULTATOPGØRELSE\").Select application.ScreenUpdating = False For i = 5 To 650 If Range(\"a\" & i & \":a\" & i + 5).Text = \"\" Then Exit For If application.WorksheetFunction.Sum(Range(\"b\" & i & \":n\" & i)) = \"0\" Then Range(i & \":\" & i).EntireRow.Hidden = True End If Next application.ScreenUpdating = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True application.ScreenUpdating = False Range(\"5:650\").EntireRow.Hidden = False application.ScreenUpdating = True Sheets(\"Valg\").Select Range(\"A1\").Select End Sub
Det er besynderligt....det er lidt det samme som med min egen makro, ved brug af din makro \"hænger\" jeg midt i processen. Med min egen makro sker det først anden gang den bliver aktiveret....jeg kan selvfølgelig lukke og genåbne filen hver gang, men det er jo præcis det jeg ønsker at undgå. Jeg har forsøgt at skære min makro over i 3 bidder, skjul - gem - udskriv. Sålænge jeg nøjes med at skifte imellem Skjul og gem virker alt fint, men når jeg så har forsøgt med at udskrive starter \"hænge\"problemet når jeg skal skulje igen....hvis du forstår....??
JEP - nu kører den noget hurtigere 2,3,4,5,6 gang her hos mig - prøv:
Sub udskrivresultat5()
application.ScreenUpdating = False
For i = 5 To 650 If Range(\"a\" & i & \":a\" & i + 5).Text = \"\" Then Exit For If application.WorksheetFunction.Sum(Range(\"b\" & i & \":q\" & i)) = \"0\" Then Range(Cells(i, 1), Cells(i, 1)).EntireRow.Hidden = True End If Next i
Mener du at jeg skal skifte alle de steder der står Range ud med Cells. Når du skriver at du har fået den til at virker...mener du så at du nu har fået den syge makro til at køre eller mener du at du rent faktisk har fået makroen til at køre uden at \"hænge\".
Jeg har det samme problem,og det er printeren(OfficeJet R 45)og jeg har prøvet alt hvad HP foreslår,uden rersultat, på andre printere er det ikke et problem, men første gang jeg udskriver det tager ca 2 min. anden gang går det lidt hurtiger men stadig ikke hurtig nok.
Jeg er tilbage fra ferie....klar til at modtage nye ideer....om det er et printer-problem ved jeg ikke, min printer er en Lexmark T614, men problematikken er åbenbart den omvendte end Gonzoo\'s, hos mig går det hurtigt første gang og derefter ekstremt sløvt !!! ???
Jeg ved ikke hvad jeg skal sige.... det hamre igennem hos mig, og jeg tror ikke på, at det har noget med printeren af gøre, for hvis jeg udkommenter den linie, som udskriver så er problemet der stadig i den oprindelige makro!!
Men jeg har ikke problemet med den \"nye\" makro.
tida-> jeg har ikke dit \"test\" ark mere, men du kan sende det til mig, og skal jeg lave det hurtigt her igen, og så kan du få den retur, for at se om det så stadig er der !!
Tak for filen, men desværre der er intet nyt under solen, problemet er det samme. Som sagt tidligere jeg har intet problem i at klippe min egen makro over i tre bidder og så kører proceduren helt problemfrit, ligesom den makro du har sendt mig igår. Men såsnart print er en del af forløbet går det galt anden gang makroen aktiveres, således også i din makro, og den bliver ekstremt sløv når den når til print delen. Så er det jeg godt kunne tænke mig at spørge....kan du køre hele makroen (incl. printdelen) 2 gange efter hinanden problemfrit ??
Tak for makro, den kører faktisk meget godt, rimelig kvik....men nu får jeg så pludselig et andet problem, den viser ikke lige det der var meningen, makroen skulle jo gerne gemme rækker med med \"0\" i hele rækken....det gør din også fint til at starte med, men så smutter det pludselig fra række 164 og ned, hvorfor forstår jeg ikke helt....men måske du gør ?????
Du kan ikke lose dit problem med, at makroen virker langtsom, salange du vil skjule rakker, hvor summen af B - O er nul. Det skal laves pa en helt anden made : Kopier resultatarket og omdob det til Printout Det skal ligge som ark 3 Indsat makroen, og det vil kore meget hurtigere. MVH Perry
Sub perry() Dim RC, RC1 As Integer \' RC rakkenr i ark 2 RC1 rakke nr i ark 3 RC = 3 RC1 = 3 application.ScreenUpdating = False
\'--------------------------------------------------------------------- \' rydder ark 3 og for fjerne formateringen
Sheets(3).Select Range(\"A3:N650\").Select selection.ClearContents Range(\"A3:N650\").Select selection.Interior.ColorIndex = xlNone selection.Font.Bold = False Range(\"A3:A650\").Select selection.Font.Bold = False selection.Interior.ColorIndex = 15 Sheets(2).Select \'------------------------------------------------------------------------- Do While RC < 650 \'kore lokken indtil rakke 650 i ark 2
If Cells(RC, 1).Value = \"\" Then \'indsatter en tom rakke i ark 3 hvis der er en tom rakke i ark 2 og formater rakke ovenover Sheets(3).Select If Cells(RC1 - 1, 1).Value = \"\" And RC1 > 3 Then GoTo Ln95 \' hvis den foregaende rakke i ark 3 er tom springer den \'formateringen over Range(\"A\" & RC1 - 1 & \":\" & \"N\" & RC1 - 1).Select selection.Interior.ColorIndex = 15 selection.Font.Bold = True selection.Borders(xlDiagonalDown).LineStyle = xlNone selection.Borders(xlDiagonalUp).LineStyle = xlNone With selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range(\"A\" & RC1 & \":\" & \"N\" & RC1).Select selection.Interior.ColorIndex = xlNone selection.Font.Bold = False RC1 = RC1 + 1 Ln95: Sheets(2).Select End If \'--------------------------------------------------------------------------- ------------- \' Overfor data som er forskellig fra 0 If Cells(RC, 14).Value <> 0 Then Sheets(\"Printout\").Cells(RC1, 1).Value = Sheets(2).Cells(RC, 1).Value Sheets(\"Printout\").Cells(RC1, 2).Value = Sheets(2).Cells(RC, 2).Value Sheets(\"Printout\").Cells(RC1, 3).Value = Sheets(2).Cells(RC, 3).Value Sheets(\"Printout\").Cells(RC1, 4).Value = Sheets(2).Cells(RC, 4).Value Sheets(\"Printout\").Cells(RC1, 5).Value = Sheets(2).Cells(RC, 5).Value Sheets(\"Printout\").Cells(RC1, 6).Value = Sheets(2).Cells(RC, 6).Value Sheets(\"Printout\").Cells(RC1, 7).Value = Sheets(2).Cells(RC, 7).Value Sheets(\"Printout\").Cells(RC1, 8).Value = Sheets(2).Cells(RC, 8).Value Sheets(\"Printout\").Cells(RC1, 9).Value = Sheets(2).Cells(RC, 9).Value Sheets(\"Printout\").Cells(RC1, 10).Value = Sheets(2).Cells(RC, 10).Value Sheets(\"Printout\").Cells(RC1, 11).Value = Sheets(2).Cells(RC, 11).Value Sheets(\"Printout\").Cells(RC1, 12).Value = Sheets(2).Cells(RC, 12).Value Sheets(\"Printout\").Cells(RC1, 13).Value = Sheets(2).Cells(RC, 13).Value Sheets(\"Printout\").Cells(RC1, 14).Value = Sheets(2).Cells(RC, 14).Value RC1 = RC1 + 1 End If RC = RC + 1 Loop \'--------------------------------------------------------------------------- -------------- application.ScreenUpdating = True Sheets(3).Select ActiveSheet.PageSetup.PrintArea = \"$A$1:$N$\" & RC1 - 2 \' angiver udskrift omradet \'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ActiveWindow.SelectedSheets.PrintPreview Sheets(\"Valg\").Select Range(\"A1\").Select End Sub
Synes godt om
Ny brugerNybegynder
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.
