Søg
Avatar billede excelent Ekspert
16. februar 2006 - 20:24 Der er 59 kommentarer og
2 løsninger

Hvem kan chiptune en sløv løkke ?

Følgende sub skjuler rækker med 0-værdier så de ikke
vises på udskriften. Selv om 5 sek. ikke er meget,
så virker det lidt iriterende at vente på.
Jeg har på fornemmelsen, at løkken skjuler, eller
forsøger at skjule rækker som allerede er skjulte.
Så hvis rækken stadig har 0 værdi ved udskriften
behøver subben jo ikke at ændre på rækkens tilstand.

Public Sub Skjul()
    'Regnskab

    Application.ScreenUpdating = False
    Worksheets("Regnskab").Activate
    For Each c In Range("e5:e15").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next

    For Each c In Range("e20:e30").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next
    For Each c In Range("e38:e41").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next

    For Each c In Range("e45:e49").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next
   
    Application.ScreenUpdating = True
    ActiveWindow.SelectedSheets.PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select

End Sub
Avatar billede kabbak Professor
16. februar 2006 - 20:33 #1
jeg ved ikke om den er hurtigere, men den er kortere

Public Sub Skjul()
    'Regnskab

    Application.ScreenUpdating = False
    For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    Worksheets("Regnskab").PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 20:40 #2
hej kabbak, jeg prøver lige.
Avatar billede excelent Ekspert
16. februar 2006 - 20:49 #3
jeg får en fejl 400
checker lige om det bare er mig
Avatar billede kabbak Professor
16. februar 2006 - 20:50 #4
hvilken linie ?
Avatar billede excelent Ekspert
16. februar 2006 - 20:52 #5
ikke nogen bestemt, og heller ikke noget med gul markering
endsige en fejltekst, kun 400
Avatar billede excelent Ekspert
16. februar 2006 - 20:55 #6
kan se at arket bliver opdateret, men den når ikke til at vise
print prew...
Avatar billede excelent Ekspert
16. februar 2006 - 20:57 #7
og ingen skjulte rækker
fandt dem frem manuelt, for at teste på det
Avatar billede bak Forsker
16. februar 2006 - 20:58 #8
Det skal da virke !!

men prøv lige

Public Sub Skjul()
  Dim c As Range
  Application.ScreenUpdating = False
  For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
      If c.Value <> 0 Then
        c.Rows.Hidden = False
      Else
        c.Rows.Hidden = True
      End If
  Next
  Application.ScreenUpdating = True
  Worksheets("Regnskab").PrintPreview
  Worksheets("Forside").Activate
  Range("m7").Select
End Sub
Avatar billede kabbak Professor
16. februar 2006 - 21:00 #9
Public Sub Skjul()
    'Regnskab
Worksheets("Regnskab").Activate
    Application.ScreenUpdating = False
    For Each c In Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value <> 0 Then
            Rows(c.Row).Hidden = False
        Else
            Rows(c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    ActiveWindow.SelectedSheets.PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub

prøv sådan
Avatar billede excelent Ekspert
16. februar 2006 - 21:04 #10
den sidste virker, men er også sløv, samt den viser arket
regnskab imens den tænker
har ikke prøvet den næstsidste, skal jeg det?
Avatar billede kabbak Professor
16. februar 2006 - 21:05 #11
ja prøv bak's
Avatar billede excelent Ekspert
16. februar 2006 - 21:06 #12
nåe hej bak, så ikke lige det var dig :-)
har nu prøvet bak's
virker, men er også sløv :-(
Avatar billede bak Forsker
16. februar 2006 - 21:07 #13
er det selve løkken der er så sløv ?
Avatar billede excelent Ekspert
16. februar 2006 - 21:08 #14
for mig at se virker det som om den skjuler el. førsøger
at skjule rækker uanset de er skjulte, sløver det ikke?
Avatar billede excelent Ekspert
16. februar 2006 - 21:09 #15
det går jeg ud fra,har en knap på forsiden, som aktiverer subben
Avatar billede bak Forsker
16. februar 2006 - 21:10 #16
Public Sub Skjul()
  Dim c As Range
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
      If c.Value = 0 Then c.Rows.Hidden = True
  Next
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Worksheets("Regnskab").PrintPreview
  Worksheets("Forside").Activate
  Range("m7").Select
End Sub
Avatar billede bak Forsker
16. februar 2006 - 21:13 #17
Jeg fatter edt ikke rigtig, det er jo kun ca 30 celler og jeg når knapt at bilnke så hurtig går det...

Har du fået fat i en gammel 386'er ?  :-)
Avatar billede excelent Ekspert
16. februar 2006 - 21:13 #18
bak's sub kl 21:10:40 er måske en anelse hurtigere
jeg fatter ikke hvorfor den skal være så længe
om at vise de få linier i det ark :-)
Avatar billede excelent Ekspert
16. februar 2006 - 21:14 #19
hehe C64
Avatar billede kabbak Professor
16. februar 2006 - 21:14 #20
Public Sub Skjul()
    'Regnskab

    Application.ScreenUpdating = False
    Worksheets("Regnskab").Cells.EntireRow.Hidden = False
    For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value = 0 Then
          Rows(c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    Worksheets("Regnskab").PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 21:16 #21
det tager ca 2-3 sek nu
Avatar billede kabbak Professor
16. februar 2006 - 21:18 #22
sidste bud

Public Sub Skjul()
    'Regnskab

    Application.ScreenUpdating = False
    Worksheets("Regnskab").Cells.EntireRow.Hidden = False
    For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value = 0 Then
          Worksheets("Regnskab").Rows(c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    Worksheets("Regnskab").PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 21:18 #23
babbak's sub kl. 21:14:42  fejl 400
Avatar billede kabbak Professor
16. februar 2006 - 21:20 #24
hvorfor får i den fejl, når jeg ikke gør ?
den virkede heller ikke ;-(
Avatar billede excelent Ekspert
16. februar 2006 - 21:22 #25
kabbak's kl 21:18:00 ok samme som bak's hurtigste

det er også til at leve med.
tak for hjælpen begge :-)

25 til hver ok ?
Avatar billede bak Forsker
16. februar 2006 - 21:24 #26
prøv lige den her

Public Sub Skjul()
  Dim c As Range
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
      If c.Value = 0 Then c.Rows.Hidden = True
  Next
  'Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Worksheets("Regnskab").PrintPreview
  Worksheets("Forside").Activate
  Range("m7").Select
End Sub
Avatar billede kabbak Professor
16. februar 2006 - 21:24 #27
det er ok, hvor meget fik vi kortet af tiden ?, halvdelen ;-))
Avatar billede bak Forsker
16. februar 2006 - 21:25 #28
og send da lige set ark, det er da defekt på en eller måde
excel snabela tbdl.dk
Avatar billede excelent Ekspert
16. februar 2006 - 21:26 #29
ok er på vej
Avatar billede kabbak Professor
16. februar 2006 - 21:27 #30
må jeg også se det
kabbak snabela tiscali punktum dk
Avatar billede excelent Ekspert
16. februar 2006 - 21:28 #31
ja kabbak ca halvdelen, lidt under
Avatar billede kabbak Professor
16. februar 2006 - 21:37 #32
prøv denne, du har måske nogen automatiske makroer, der kører

Public Sub Skjul()
    'Regnskab

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Worksheets("Regnskab").Cells.EntireRow.Hidden = False
    For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value = 0 Then
          Worksheets("Regnskab").Rows(c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Worksheets("Regnskab").PrintPreview
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 21:40 #33
ok prøver
Avatar billede excelent Ekspert
16. februar 2006 - 21:44 #34
den sidste er måske en anelse hurtigere, er svært at vurdere
måske et lille halvt sekund :-)
Avatar billede excelent Ekspert
16. februar 2006 - 21:46 #35
sender nu kabbak
Avatar billede bak Forsker
16. februar 2006 - 21:48 #36
modtaget
Avatar billede kabbak Professor
16. februar 2006 - 21:51 #37
modtaget
Avatar billede excelent Ekspert
16. februar 2006 - 21:51 #38
ok
Avatar billede bak Forsker
16. februar 2006 - 22:16 #39
Her er et alternativ, men om det er hurtige ved jeg ikke. Jeg synes faktisk at den game var kvik nok

Public Sub Skjul()
  Worksheets("Regnskab").Range("E4:E51").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
  Worksheets("Regnskab").PrintPreview
  Worksheets("Forside").Activate
  Range("m7").Select
End Sub
Avatar billede bak Forsker
16. februar 2006 - 22:20 #40
,,rel.
De bogstaver og tegn jeg manglede i øverste linie :-)
Avatar billede excelent Ekspert
16. februar 2006 - 22:23 #41
ok prøver
Avatar billede excelent Ekspert
16. februar 2006 - 22:25 #42
hold da op det hjalp :-)
nu er det lige som at klikke på printprew.. knappen
well done bak
Avatar billede bak Forsker
16. februar 2006 - 22:25 #43
sæt evt.  application.screenupdating=false ind for at hindre flimme
Avatar billede excelent Ekspert
16. februar 2006 - 22:30 #44
ja lige under public sub...
og sætte til true lige før End sub  ik' ?

men det går nu så stærkt, så det måske ikke er nødvendigt
Avatar billede excelent Ekspert
16. februar 2006 - 22:33 #45
der er kommet en lille box med pil i arket bak, er det
en extra feature ?
Avatar billede bak Forsker
16. februar 2006 - 22:34 #46
Jeps, det er autofilter.
Prøv lige at fjerne det og test denne her i stedet (bare for sjov)

Public Sub Skjul()
Dim sc As Range
Dim c As Range
  Set sc = Worksheets("Regnskab").Range("e65")
  Application.ScreenUpdating = False
  For Each c In Worksheets("Regnskab").Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
      If c.Value = 0 Then Set sc = Union(sc, c)
  Next
  sc.Rows.Hidden = True
  Worksheets("Regnskab").PrintPreview
  Worksheets("Forside").Activate
  Range("m7").Select
  Application.ScreenUpdating = True
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 22:36 #47
ok tester
Avatar billede kabbak Professor
16. februar 2006 - 22:39 #48
Ok jeg har splittet koden ad,

I modulet i arket regnskab :

Private Sub Worksheet_Activate()
    Cells.EntireRow.Hidden = False
    For Each c In Range("e5:e15,e20:e30,e38:e41,e45:e49").Cells
        If c.Value = 0 Then
            Rows(c.Row & ":" & c.Row).Hidden = True
        End If
    Next
    Application.ScreenUpdating = True

End Sub

den anden

Public Sub Skjul()
'Regnskab

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Worksheets("Regnskab").Activate
    ActiveWindow.SelectedSheets.PrintPreview
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Worksheets("Forside").Activate
    Range("m7").Select
End Sub


prøv at teste
Avatar billede excelent Ekspert
16. februar 2006 - 22:39 #49
laver lidt ravage i udskriften, får 2 linier med årets resultat
Avatar billede excelent Ekspert
16. februar 2006 - 22:40 #50
satte den lille sub ind igen så er det ok
Avatar billede kabbak Professor
16. februar 2006 - 22:41 #51
her er en anden af dine makroer, som er kortet ned

Sub SletAlle()
    Response = MsgBox("", vbYesNo, "  Skal Alle sider slettes ?  ")
    If Response = vbYes Then

        Application.ScreenUpdating = False
        For i = 1 To 10
            Worksheets("Side " & i).Range("B5:H27").ClearContents
        Next
        Worksheets("Forside").Range("m7").Select
        Application.ScreenUpdating = True
    Else
    End If
End Sub
Avatar billede excelent Ekspert
16. februar 2006 - 22:42 #52
prøver kabbaks nu
Avatar billede excelent Ekspert
16. februar 2006 - 22:45 #53
har nu prøvet kabbaks også
jeg tror de er lige hurtige
Avatar billede excelent Ekspert
16. februar 2006 - 22:48 #54
kabbak's Sub SletAlle() indsætter jeg ved lejlighed
tak for den bak
Avatar billede excelent Ekspert
16. februar 2006 - 22:49 #55
ups kabbak mente jeg
Avatar billede kabbak Professor
16. februar 2006 - 22:50 #56
jeg hedder også Bak
Avatar billede excelent Ekspert
16. februar 2006 - 22:50 #57
så er det bare at vælge :-)
et luxus problem
men flot arbejde begge 2
Avatar billede kabbak Professor
16. februar 2006 - 22:52 #58
jegsender lige den jeg arbejdede med, retur
Avatar billede excelent Ekspert
16. februar 2006 - 22:53 #59
nå ok så kan det jo ikke gå galt :-)
får i brug for en til at skifte sub's ud,
så sig til, tror jeg har det i fingrene nu lol
Avatar billede excelent Ekspert
16. februar 2006 - 22:55 #60
ok kabbak
Avatar billede excelent Ekspert
16. februar 2006 - 22:59 #61
modtaget
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
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Kan Excel selv beregne alder? Af leahcim i Excel 6 31/08/202610:24 I går 15:32
problem med mailbesked Af Pestilensen i Excel 3 24/08/202611:16 28/08/202612:55
Sætte billeder ind i google sheets ark ud fra elev nummer Af lurup i Excel 16 17/08/202615:14 27/08/202601:20
Gemme største værdi Af Lemming@privat.dk i Excel 2 07/08/202622:13 08/08/202609:03
Forskel mellem klokkeslet start aften slut næste morgen Af krasmussen i Excel 13 24/07/202611:08 03/08/202618:42
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
31/0810:26 Synkronisering af kalender mellem computer, android telefon og iPhone Af Strawberry i Andre onlineløsninger
31/0810:24 Kan Excel selv beregne alder? Af leahcim i Excel
30/0815:02 Gemme besked fra Facebook / Messenger Af lurup i Sociale medier
29/0820:17 Kan man kopiere en DVD og afspille den på * Linux Mint - Cinnamon - 22.1 - "Xia" * ? Af Ikke-ekspert i Linux
27/0821:03 Kan man få Word viewer gratis Af Strawberry i Word
White papers
Flere white papers »