Avatar billede madsberg Juniormester
03. november 2009 - 07:53 Der er 4 kommentarer og
1 løsning

Betinget sideskift

Hej
Jeg har et regneark bestående af en masse kunder. Alle data står i kolonne A og så er der ca. 2000 rækker bestående i første række af: "Kundenr."  "xxx"  "tur yyy"  (xxx er kundenummeret og yyy er turnummeret); anden række er adressen; tredie række er postnr.+by; fjerde række er typisk Att.: "navn" og så kommer der ca. 2-3 blanke linier.
Det jeg søger er en makro der automatisk indsætter et sideskift hver gang en række starter med "Kundenr.", således af hver side begynder med rækken "Kundenr.".......
Der kommer et nyt "Kundenr."..... på ca. hver 7-9 række.
Hvis det er for kompliceret at der står "Kundenr." og så noget mere på første række, vil jeg godt omformulere opgaven, således at der kun står "Kundenr." og intet andet i første linie.
Altså indsætte et automatisk horisontalt sideskift hver gang der står teksten "Kundenr." i kolonne A.
Håber nogen kan hjælpe mig.
Avatar billede jkrons Professor
03. november 2009 - 14:51 #1
Prøv

Sub Sideskift()
For Each c In Range("A2:A65000").Cells
    If UCase(c.Value) = "KUNDENR." Then
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=c
    End If
Next
End Sub
Avatar billede Niels_Bjarne Praktikant
03. november 2009 - 15:23 #2
Denne version starter med at fjerne allerede indsatte sideskift, og der kan stå noget efter Kundenr. i cellen.

Sub InsertPagebreak()
    Dim cell As Range
    Dim index As Long
    Dim soegetext As String
   
    soegetext = "Kundenr."
   
    For index = ActiveSheet.HPageBreaks.Count To 1 Step -1
        ActiveSheet.HPageBreaks(index).Delete
    Next index
   
    For Each cell In Range("a:a")
        If Left(cell.Value, Len(soegetext)) = soegetext Then
            ActiveSheet.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub
Avatar billede madsberg Juniormester
03. november 2009 - 16:37 #3
Hej jkrons og Niels Bjarne
Tak for svarene.
Jeg har ikke den rigtige fil ved hånden, men har lavet en test.
jkrons svar virker, men jeg har tænkt mig at efterfølge Niels Bjarne's mere avancerede og mere korrekte svar til mit brug.
Men Niels Bjarne, dit svar giver en Fejl 1004
Application or objectdefined error
i linien:

ActiveSheet.HPageBreaks.Add Before:=cell

Jeg kan dog ikke umiddelbart se hvorfor, da det ser korrekt ud, uden dog at være ekspert.
Men den fjerner dog jkrons indsatte sideskift
Mvh  Mads
Avatar billede Niels_Bjarne Praktikant
04. november 2009 - 10:33 #4
Jeg ved ikke hvad fejlen hos dig skyldes. Fejlmeldingen siger mig ikke noget. Jeg har testet koden hos mig, og der giver den ingen fejl.
Men for at finde en løsning til dig, har jeg ændret mit forslag med dele af jkrons forslag (jkrons ved mere om Excel end jeg gør ;-), da hans forslag virker ved dig.
Du skal dog være opmærksom på, at hvis du har flere faner markeret, når du afvikler makroen, så fjernes kun sideskift på den aktive fane, mens der indsættes nye sideskift i alle markerede faner. Har du kun en fane markeret, så skulle det virke.


Sub InsertPagebreak()
    Dim cell As Range
    Dim index As Long
    Dim soegetext As String
   
    soegetext = "KUNDENR."
   
    For index = ActiveWindow.SelectedSheets.HPageBreaks.Count To 1 Step -1
        ActiveWindow.SelectedSheets.HPageBreaks(index).Delete
    Next index
   
    For Each cell In Range("a:a")
        If UCase(Left(cell.Value, Len(soegetext))) = soegetext Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub
Avatar billede madsberg Juniormester
04. november 2009 - 12:57 #5
Hej Niels Bjarne
Da jeg kom på arbejdet og prøvede på den rigtige fil, så stoppede din makro allerede ved:
ActiveWindow.SelectedSheets.HPageBreaks(index).Delete
Din reviderede makro stopper også samme sted med fejlmeddelsen: Subscript out of range.
Men jeg har ændret lidt i din første makro, således at det virker i min fil.
Sub InsertPagebreak()
    Dim cell As Range
    Dim soegetext As String
   
    soegetext = "Kundenr."
    ActiveSheet.ResetAllPageBreaks
     
    For Each cell In Range("a:a")
        If Left(cell.Value, Len(soegetext)) = soegetext Then
          ActiveSheet.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub

Mange tak for hjælpen
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