Ja, det er jo nok lidt forkert at spørge på den måde. Men den kode der skal rettes i er blevet temmelig lang. Jeg tror ikke at rettelsen er speciel svær, men koden i sig selv kan jo godt gøre det hle uoverskuelig.
Public Sub DAN_SPECIFIKATIONER_til_Udskrift() Dim Data As Variant, I As Integer, X As Integer, SumPoster As Variant, ErDerSumposter As Boolean, RK As Integer Dim NR As Integer, Antal() As Variant, T As Integer, N As Integer, RækkeStart As Integer, OV As Variant, Tid As Date Dim MinRækker As Integer
Tid = Now ErDerSumposter = False RK = 0 Application.Calculation = xlCalculationManual ' stopper automatisk udregning af formler Application.ScreenUpdating = False With Worksheets("Konto") MinRækker = .Range("G1") ' Minimum rækker incl overskrift og total ' Tjekker om der valgt overskrifter, det skal være det samme i N og O kolonnen Data = .Range("A5:P" & .Range("B65536").End(xlUp).Row + 50) ' indlæser kontoplan i variablen Data + 50 tomme rækker
Tjek = .Range("N5:O" & .Range("B65536").End(xlUp).Row) .Range("C200").End(xlUp).Value = WorksheetFunction.Sum(.Range("C1:C200")) * -1 .Range("E200").End(xlUp).Value = WorksheetFunction.Sum(.Range("E1:E200")) * -1 With Worksheets("overskrift") 'tilrettes til ark med overskrifter Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row) End With SidsteData = UBound(Data) For I = 1 To UBound(Tjek) OK = False For Y = 1 To UBound(Tjek) If Not IsEmpty(Tjek(I, 1)) Then If Tjek(I, 1) = Tjek(Y, 2) Then OK = True Exit For End If Else OK = True End If Next If Not OK Then Application.ScreenUpdating = True Application.Calculation = xlCalculationManual ' starter automatisk udregning af formler MsgBox "Du har glemt at angive nr i kolonne O i linien(" & .Range("O" & I + 4).Offset(0, -14) & " " & .Range("O" & I + 4).Offset(0, -13) & ")"
Exit Sub End If Next
End With ' kolonner i variablen Data ' Tekst, importeret fra regnskabssystem ' i år ' x ' sidste år ' x ' specnr. I år ' Overskrift ' * ' specnr. sidste år ' 1 2 3 4 5 6 7 8 9 10 ' Overskrift ' * ' x ' Liner som skal samles' Hvilken TEKST / NAVN skal vises' Alt:Titel ' 11 12 13 14 15 16 With Worksheets("overskrift") 'tilrettes til ark med overskrifter Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row) End With
K1 = 0 ' nulstiller antal samledata For I = 1 To UBound(Data) If IsEmpty(Data(I, 7)) And IsEmpty(Data(I, 10)) Then If RK = 0 Then RK = I ' første række der er ledig i Variablen Data For X = 1 To UBound(Data, 2) Data(I, X) = Empty ' sletter data der ikke har et specnr Next Else Data(I, 3) = Data(I, 3) * Data(I, 9) ' ganger beløbet
If IsEmpty(Data(I, 10)) Then ' hvis faktor for sidste år er tom, bruges dette år Data(I, 5) = Data(I, 5) * Data(I, 9) ' ganger beløbet Sidste år med faktor i år Else Data(I, 5) = Data(I, 5) * Data(I, 12) ' ganger beløbet Sidste år med faktor Sidste år End If End If Next
'**************************************************** slut med at tælle sumposter og gange med faktor ***********************
'******************************************************* Begynder at dele konti på specnr per år ***********************************
SidsteData = RK - 1 NR = RK For I = 1 To SidsteData If Not IsEmpty(Data(I, 7)) And Not IsEmpty(Data(I, 10)) Then For X = 1 To UBound(Data, 2) Data(NR, X) = Data(I, X) Next Data(NR, 3) = 0 Data(I, 5) = 0 Data(NR, 7) = Data(I, 10) * 100 If Not IsEmpty(Data(I, 15)) Then Data(NR, 15) = Data(I, 15) * 100 ' specnr* 100, på dem der skal adskilles, for sidste år
Data(NR, 14) = Data(I, 14) * 100 ' specnr* 100, på dem der skal adskilles, for sidste år
NR = NR + 1 End If If Not IsEmpty(Data(I, 16)) Then Data(I, 2) = Data(I, 16) Next Sheets.Add ActiveSheet.Name = "TEMP" ' bruger et midlertidig ark til sortering Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Data = Range("A1").Resize(NR + 50, UBound(Data, 2)) Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True SidsteData = NR '******************************************************* Færdig med at dele konti på specnr per år ***********************************
'******************************************************* Begynder at summere, dem der skal *********************************** For I = 1 To SidsteData
If Not IsEmpty(Data(I, 15)) Then K1 = K1 + 1 ' tæller antal samledata ReDim Preserve Antal(K1) Antal(K1) = Data(I, 15) ErDerSumposter = True End If Next ' kolonner i variablen Data ' Tekst, importeret fra regnskabssystem ' i år ' x ' sidste år ' x ' specnr. I år ' Overskrift ' * ' specnr. sidste år ' 1 2 3 4 5 6 7 8 9 10 ' Overskrift ' * ' x ' Liner som skal samles' Hvilken TEKST / NAVN skal vises' Alt:Titel ' 11 12 13 14 15 16 If ErDerSumposter Then For X = 1 To UBound(Antal) For I = 1 To SidsteData If Antal(X) = Data(I, 14) Then ' passer sammentællingskoden, så fortsæt If Not IsEmpty(Data(I, 16)) Then ' er der special overskrift Data(NR + X, 2) = Data(I, 16) ' special Overskrift ElseIf Not IsEmpty(Data(I, 15)) Then ' eller er der et tal ud for en anden Data(NR + X, 2) = Data(I, 2) ' normal Overskrift End If Data(NR + X, 1) = Data(I, 1) Data(NR + X, 3) = Data(NR + X, 3) + Data(I, 3) ' summere dette år Data(NR + X, 5) = Data(NR + X, 5) + Data(I, 5) ' summere sidste år Data(NR + X, 7) = Data(I, 7) ' specnr For T = 1 To UBound(Data, 2) Data(I, T) = Empty ' sletter data efter summering Next End If Next Next End If
For X = 1 To UBound(Data) If Data(X, 7) > 100 Then Data(X, 7) = Data(X, 7) / 100 ' Retter specnr, på dem der skal adskilles, for sidste år Next Sheets.Add ' bruger et midlertidig ark til sortering ActiveSheet.Name = "TEMP1" Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Application.DisplayAlerts = False Data = Range("A1:G" & Range("B65536").End(xlUp).Row) ActiveSheet.Delete Application.DisplayAlerts = True
'******************************************************* summerering slut ***********************************
Worksheets("spec1").Activate With Worksheets("spec1") Cells.Rows.Hidden = False ActiveSheet.DisplayPageBreaks = False ' *********************************************Rettet gammel kode ********************************
For I = 1 To UBound(Overskrifter) 'Overskrifter løbes igennem
For J = 1 To SidsteData 'antal poster = kriterier tælles op
If Data(J, 7) = Overskrifter(I, 1) Then
If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then K = K + 1 End If End If ' ' If Data(J, 7) > Overskrifter(I, 1) Then Exit For Next J
If K > 0 Then ReDim Poster(K - 1, 7) K = 0
For J = 1 To SidsteData 'Kontoplan løbes igennem If Data(J, 7) > Overskrifter(I, 1) Then Exit For If Data(J, 7) = Overskrifter(I, 1) Then
If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then Poster(K, 1) = Data(J, 2) 'tekst/kontonavn Poster(K, 3) = Data(J, 3) 'beløb i år Poster(K, 5) = Data(J, 5) 'beløb sidste år Poster(K, 7) = Data(J, 1) 'kontonr. K = K + 1 totaliår = totaliår + Data(J, 3) totalsidsteår = totalsidsteår + Data(J, 5)
End If End If Next J '**************************************** KABBAK ************************************************* End If OV = Worksheets("spec1").Range("B6:B" & Worksheets("spec1").Range("B1000").End(xlUp).Row) For Y = UBound(OV) To 1 Step -1 If OV(Y, 1) = Overskrifter(I, 2) And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then RækkeStart = Y + 5 '<<<< Finder rækkenr. for overskrift >>>> Exit For End If If OV(Y, 1) = Overskrifter(I, 2) & " i alt " And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then Rækkeslut = Y + 5 '<<<< Finder rækkenr. for overskrift i alt >>>> Next
If Rækkeslut - RækkeStart > 1 Then .Rows(RækkeStart + 1 & ":" & Rækkeslut - 1).Delete End If
'<<<< indsætter rækker og data og totaler mellem overskrift og i alt >>>> If K > 0 Then
'<<<< Nulstiller totaler og tæller inden næste overskrift hentes ind >>>> K = 0: totaliår = 0: totalsidsteår = 0 Application.StatusBar = "Danner SPECIFIKATION " & I & " af " & UBound(Overskrifter)
Application.StatusBar = "" ActiveSheet.DisplayPageBreaks = True Application.Calculation = xlCalculationAutomatic ' Slår automatiske beregninger til igen Application.ScreenUpdating = True ' slår opdatering af skærmen til igen .Range("F7").Select End With MsgBox Format(Now() - Tid, "nn:ss") ' bare kommenter den ud, den viser tiden som koden tager for at køre. End Sub
Det er i det her område der skal rettes. (tror jeg nok) :-) Men det er vist umiligt at forklare. Man skal have arket foran sig, for at forstå mit problem :-)
For I = 1 To SidsteData
If Not IsEmpty(Data(I, 15)) Then K1 = K1 + 1 ' tæller antal samledata ReDim Preserve Antal(K1) Antal(K1) = Data(I, 15) ErDerSumposter = True End If Next ' kolonner i variablen Data ' Tekst, importeret fra regnskabssystem ' i år ' x ' sidste år ' x ' specnr. I år ' Overskrift ' * ' specnr. sidste år ' 1 2 3 4 5 6 7 8 9 10 ' Overskrift ' * ' x ' Liner som skal samles' Hvilken TEKST / NAVN skal vises' Alt:Titel ' 11 12 13 14 15 16 If ErDerSumposter Then For X = 1 To UBound(Antal) For I = 1 To SidsteData If Antal(X) = Data(I, 14) Then ' passer sammentællingskoden, så fortsæt If Not IsEmpty(Data(I, 16)) Then ' er der special overskrift Data(NR + X, 2) = Data(I, 16) ' special Overskrift ElseIf Not IsEmpty(Data(I, 15)) Then ' eller er der et tal ud for en anden Data(NR + X, 2) = Data(I, 2) ' normal Overskrift End If Data(NR + X, 1) = Data(I, 1) Data(NR + X, 3) = Data(NR + X, 3) + Data(I, 3) ' summere dette år Data(NR + X, 5) = Data(NR + X, 5) + Data(I, 5) ' summere sidste år Data(NR + X, 7) = Data(I, 7) ' specnr For T = 1 To UBound(Data, 2) Data(I, T) = Empty ' sletter data efter summering Next End If Next Next End If
koden lægger tal fra kolonne 5 i alle de linier der har samme kode (1 eller 2 eller 3) i kolonne 14 og 15. Det samme gælder for kolonne 7.
Men hvis de 2 linier ikke ligger lige op af hinanden går det galt. (hvis der er f.eks. er 2 linier som ikke har samme koden mellen de linier som skal lægges sammen)
har læst den beskrivelse jeg har givet igennem. Jeg kan ikke se at jeg beskriver fejlen forkert. :-( Det er lidt kringlet, men jeg kan ikke se at det er forkert.
Nu, kan jeg godt se at jeg fik skrevet SPEC1 istedet for KONTO, sorry :-)
ja, så vidt jeg kan se, så er det der det går galt Hvis du kigger i arket TEMP1 så er den galt med den linie som kommer frem med konto 1917. Den skulle have heddet 1010, da det er den linie som bestemmer teksten (Den der har "1" i kolonne O i arket KONTO)
Hvis det kommer på plads i arket TEMP1, så skulle den automatisk komme korrekt over i SPEC1, men jeg kan simpelthen ikke gennemskue hvor i koden det skal rettes.
jep. Som det er nu bliver de lagt sammen i konto 1917. De skal blot lægges sammen i en linie med konto 1010. (i kolonne A)
Det er umiddelbart den eneste korrektion der skal laves, men den er ret vigtig.
Det nr. de skal lægges sammen under er det nr. som har en kode i kolonne O i KONTO. Den gør det allerede korrekt med NAVNET i KOLONNE B, men det går galt i kolonne A
ja, det kan man godt sige. Den skal lægge tallene sammen i kolonne 5 og 7 og "slette" de andre linier, men selvfølgelig kun i arkene "TEMP1" og "SPEC1"
Den gør det allerede, det er blot det tal der kommer i kolonne A der er forkert. Hvis der kommer 1010 i stedet for 1917, tror jeg den er i vinkel.
koden sætter automatisk det kontonr ind der står nederst af de linier som skal lægges sammen. Den skal i stedet bruge dne linie der har "1" i kolonne O i arket KONTO
Public Sub DAN_SPECIFIKATIONER_til_Udskrift() Dim Data As Variant, I As Integer, X As Integer, SumPoster As Variant, ErDerSumposter As Boolean, RK As Integer Dim NR As Integer, Antal() As Variant, T As Integer, N As Integer, RækkeStart As Integer, OV As Variant, Tid As Date Dim MinRækker As Integer
Sheets("TEMP1").Select ActiveSheet.Delete Tid = Now ErDerSumposter = False RK = 0 Application.Calculation = xlCalculationManual ' stopper automatisk udregning af formler Application.ScreenUpdating = False With Worksheets("Konto") MinRækker = .Range("G1") ' Minimum rækker incl overskrift og total ' Tjekker om der valgt overskrifter, det skal være det samme i N og O kolonnen Data = .Range("A5:P" & .Range("B65536").End(xlUp).Row + 50) ' indlæser kontoplan i variablen Data + 50 tomme rækker
Tjek = .Range("N5:O" & .Range("B65536").End(xlUp).Row) .Range("C200").End(xlUp).Value = WorksheetFunction.Sum(.Range("C1:C200")) * -1 .Range("E200").End(xlUp).Value = WorksheetFunction.Sum(.Range("E1:E200")) * -1 With Worksheets("overskrift") 'tilrettes til ark med overskrifter Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row) End With SidsteData = UBound(Data) For I = 1 To UBound(Tjek) OK = False For Y = 1 To UBound(Tjek) If Not IsEmpty(Tjek(I, 1)) Then If Tjek(I, 1) = Tjek(Y, 2) Then OK = True If Tjek(I, 2) = 1 Then Kontonr = Data(I, 1) End If Exit For End If Else OK = True End If Next If Not OK Then Application.ScreenUpdating = True Application.Calculation = xlCalculationManual ' starter automatisk udregning af formler MsgBox "Du har glemt at angive nr i kolonne O i linien(" & .Range("O" & I + 4).Offset(0, -14) & " " & .Range("O" & I + 4).Offset(0, -13) & ")"
Exit Sub End If Next
End With ' kolonner i variablen Data ' Tekst, importeret fra regnskabssystem ' i år ' x ' sidste år ' x ' specnr. I år ' Overskrift ' * ' specnr. sidste år ' 1 2 3 4 5 6 7 8 9 10 ' Overskrift ' * ' x ' Liner som skal samles' Hvilken TEKST / NAVN skal vises' Alt:Titel ' 11 12 13 14 15 16 With Worksheets("overskrift") 'tilrettes til ark med overskrifter Overskrifter = .Range("A2:C" & .Range("B200").End(xlUp).Row) End With
K1 = 0 ' nulstiller antal samledata For I = 1 To UBound(Data) If IsEmpty(Data(I, 7)) And IsEmpty(Data(I, 10)) Then If RK = 0 Then RK = I ' første række der er ledig i Variablen Data For X = 1 To UBound(Data, 2) Data(I, X) = Empty ' sletter data der ikke har et specnr Next Else Data(I, 3) = Data(I, 3) * Data(I, 9) ' ganger beløbet
If IsEmpty(Data(I, 10)) Then ' hvis faktor for sidste år er tom, bruges dette år Data(I, 5) = Data(I, 5) * Data(I, 9) ' ganger beløbet Sidste år med faktor i år Else Data(I, 5) = Data(I, 5) * Data(I, 12) ' ganger beløbet Sidste år med faktor Sidste år End If End If Next
'**************************************************** slut med at tælle sumposter og gange med faktor ***********************
'******************************************************* Begynder at dele konti på specnr per år ***********************************
SidsteData = RK - 1 NR = RK For I = 1 To SidsteData If Not IsEmpty(Data(I, 7)) And Not IsEmpty(Data(I, 10)) Then For X = 1 To UBound(Data, 2) Data(NR, X) = Data(I, X) Next Data(NR, 3) = 0 Data(I, 5) = 0 Data(NR, 7) = Data(I, 10) * 100 If Not IsEmpty(Data(I, 15)) Then Data(NR, 15) = Data(I, 15) * 100 ' specnr* 100, på dem der skal adskilles, for sidste år
Data(NR, 14) = Data(I, 14) * 100 ' specnr* 100, på dem der skal adskilles, for sidste år
NR = NR + 1 End If If Not IsEmpty(Data(I, 16)) Then Data(I, 2) = Data(I, 16) Next Sheets.Add ActiveSheet.Name = "TEMP" ' bruger et midlertidig ark til sortering Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Data = Range("A1").Resize(NR + 50, UBound(Data, 2)) Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True SidsteData = NR '******************************************************* Færdig med at dele konti på specnr per år ***********************************
'******************************************************* Begynder at summere, dem der skal *********************************** For I = 1 To SidsteData
If Not IsEmpty(Data(I, 15)) Then K1 = K1 + 1 ' tæller antal samledata ReDim Preserve Antal(K1) Antal(K1) = Data(I, 15) ErDerSumposter = True End If Next ' kolonner i variablen Data ' Tekst, importeret fra regnskabssystem ' i år ' x ' sidste år ' x ' specnr. I år ' Overskrift ' * ' specnr. sidste år ' 1 2 3 4 5 6 7 8 9 10 ' Overskrift ' * ' x ' Liner som skal samles' Hvilken TEKST / NAVN skal vises' Alt:Titel ' 11 12 13 14 15 16 If ErDerSumposter Then For X = 1 To UBound(Antal) For I = 1 To SidsteData If Antal(X) = Data(I, 14) Then ' passer sammentællingskoden, så fortsæt If Not IsEmpty(Data(I, 16)) Then ' er der special overskrift Data(NR + X, 2) = Data(I, 16) ' special Overskrift ElseIf Not IsEmpty(Data(I, 15)) Then ' eller er der et tal ud for en anden Data(NR + X, 2) = Data(I, 2) ' normal Overskrift
End If Data(NR + X, 1) = Kontonr '"1010" 'Data(I, 1) Data(NR + X, 3) = Data(NR + X, 3) + Data(I, 3) ' summere dette år Data(NR + X, 5) = Data(NR + X, 5) + Data(I, 5) ' summere sidste år Data(NR + X, 7) = Data(I, 7) ' specnr For T = 1 To UBound(Data, 2) Data(I, T) = Empty ' sletter data efter summering Next End If Next Next End If
For X = 1 To UBound(Data) If Data(X, 7) > 100 Then Data(X, 7) = Data(X, 7) / 100 ' Retter specnr, på dem der skal adskilles, for sidste år Next Sheets.Add ' bruger et midlertidig ark til sortering ActiveSheet.Name = "TEMP1" Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)) = Data Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("A1") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Application.DisplayAlerts = False Data = Range("A1:G" & Range("B65536").End(xlUp).Row) 'ActiveSheet.Delete Application.DisplayAlerts = True
'******************************************************* summerering slut ***********************************
Worksheets("spec1").Activate With Worksheets("spec1") Cells.Rows.Hidden = False ActiveSheet.DisplayPageBreaks = True For I = 2 To .Range("B1000").End(xlUp).Row Rows(I).PageBreak = xlPageBreakNone ' fjerner sideskift Rows(I).PageBreak = xlNone Next ActiveSheet.DisplayPageBreaks = False ' *********************************************Rettet gammel kode ********************************
For I = 1 To UBound(Overskrifter) 'Overskrifter løbes igennem
For J = 1 To SidsteData 'antal poster = kriterier tælles op
If Data(J, 7) = Overskrifter(I, 1) Then
If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then K = K + 1 End If End If ' ' If Data(J, 7) > Overskrifter(I, 1) Then Exit For Next J
If K > 0 Then ReDim Poster(K - 1, 7) K = 0
For J = 1 To SidsteData 'Kontoplan løbes igennem If Data(J, 7) > Overskrifter(I, 1) Then Exit For If Data(J, 7) = Overskrifter(I, 1) Then
If Data(J, 3) <> 0 Or Data(J, 5) <> 0 Then Poster(K, 1) = Data(J, 2) 'tekst/kontonavn Poster(K, 3) = Data(J, 3) 'beløb i år Poster(K, 5) = Data(J, 5) 'beløb sidste år Poster(K, 7) = Data(J, 1) 'kontonr. K = K + 1 totaliår = totaliår + Data(J, 3) totalsidsteår = totalsidsteår + Data(J, 5)
End If End If Next J '**************************************** KABBAK ************************************************* End If OV = Worksheets("spec1").Range("B6:B" & Worksheets("spec1").Range("B1000").End(xlUp).Row) For Y = UBound(OV) To 1 Step -1 If OV(Y, 1) = Overskrifter(I, 2) And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then RækkeStart = Y + 5 '<<<< Finder rækkenr. for overskrift >>>> Exit For End If If OV(Y, 1) = Overskrifter(I, 2) & " i alt " And .Cells(Y + 5, "I") = Overskrifter(I, 1) Then Rækkeslut = Y + 5 '<<<< Finder rækkenr. for overskrift i alt >>>> Next
If Rækkeslut - RækkeStart > 1 Then .Rows(RækkeStart + 1 & ":" & Rækkeslut - 1).Delete End If
'<<<< indsætter rækker og data og totaler mellem overskrift og i alt >>>> If K > 0 Then
End If 'Den må altså ikke skjule grupperne 1-13 og 69-74, da Select Case Overskrifter(I, 1) Case 1 To 13, 69 To 74 Case Else If K + 2 <= MinRækker + 2 Then .Rows(RækkeStart - 1 & ":" & RækkeStart + K + 2).Hidden = True End If End Select
'<<<< Nulstiller totaler og tæller inden næste overskrift hentes ind >>>> K = 0: totaliår = 0: totalsidsteår = 0 Application.StatusBar = "Danner SPECIFIKATION " & I & " af " & UBound(Overskrifter)
Application.StatusBar = "" ActiveSheet.DisplayPageBreaks = True Application.Calculation = xlCalculationAutomatic ' Slår automatiske beregninger til igen Application.ScreenUpdating = True ' slår opdatering af skærmen til igen .Range("F7").Select End With MsgBox Format(Now() - Tid, "nn:ss") ' bare kommenter den ud, den viser tiden som koden tager for at køre. End Sub
Jeg er ved at gå lidt kold i det VBA. Bruger det for lidt..
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.
Ny bruger
Nybegynder
Opret
Preview
