06. januar 2002 - 13:01Der er
20 kommentarer og 1 løsning
Macro/script til autoformatering.
Jeg har et Excel-regneark som består af rækkerne A3 til P41. Række 3 er en overskrift for alle linie. Række 4 er en overskriftslinie som skal stå hver gang kundenr. i kolonne A skifter. Række 41 er en form for statuslinie/afslutning på en kunde, som altså skal stå før en ny kundenr i kolonne A. Rækkerne 4 til 40 er detail linier hvor kolonne A er kundenr. og hvor det fra gang til gang veksler hvor mange linier der er udfyldt.
Opgaven er at lave en macro automatisk indsætter overskrift(række 4) og statuslinie(række 41) når kundenr. skifter, samt slette evt. ikke udfyldte linier.
Denne makro burde kunne gøre det, hvis jeg ellers har læst opgaven rigtigt: Sub Macro3() fast1 = 41 fast2 = 4 For x = 6 To fast1 If Cells(x, 1).Value <> Cells(x - 1, 1).Value Then fast1 = fast1 + 1 Rows(x).Insert Shift:=xlDown Rows(fast1).Copy Rows(x).Select ActiveSheet.Paste Rows(x + 1).Insert Shift:=xlDown Rows(fast2).Copy Rows(x + 1).Select ActiveSheet.Paste x = x + 2 fast1 = fast1 + 1 End If Next x Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.ClearContents End Sub
Jeg sidder nu og kikker på regnearket og tror det er lidt i stykker - måske har du haft nogle referancer til et andet ark?
Hvor står kundernes navne ? Hvor for du \"afgang\" fra ? Hvor står \"prøve: \"ja\" ? Efter række 24 er der ingen værdier. Du skriver række 41 er en statuslinie - hvad gør den status over? I det tilsendte rengeark er den tom - sikkert også p.g.a. mangelnde referancer.
Jeg kan sagtnes lytte rundt på det som du gerne vil have, men mangler lige lidt info om ovenstående *S*
\'Tæller rækker der data i række = 6 Do række = række + 1 Loop Until (Cells(række, 1) = \"\")
\'Finder sidste brugte række ActiveCell.SpecialCells(xlLastCell).Select \'Gå en celle op ActiveCell.Offset(-1, 0).Range(\"A1\").Select
\'Vælger området fra sidste celle med data til sidste celle -1 og sletter det Range(Cells(række, 1), Cells(ActiveCell.Row, ActiveCell.Column)).Select Selection.EntireRow.Delete Application.CutCopyMode = False
\'Gennemløber celler med data og indsætter overskrifter og underskrifter Overskift = 4 Underskrift = række
For n = 6 To række
If Cells(n, 1).Value <> Cells(n - 1, 1).Value Then Underskrift = Underskrift + 1 Rows(n).Insert Shift:=xlDown Rows(Underskrift).Copy Rows(n).Select ActiveSheet.Paste Rows(n + 1).Insert Shift:=xlDown Rows(\"4\").Copy Rows(n + 1).Select ActiveSheet.Paste n = n + 2 Underskrift = Underskrift + 1 End If Next n
Det ser ud til at der kun er en enkelt ting som ikke virker.
Overskriften med opslag fungerer fint, men \"underskriften\" indeholder som du antydede også en sammensætning af forskellige opslag og det går galt. Når formateringen er foretaget står der en masse #######. Når man kigger i felter kan man se at nogle henvisger er erstattet af \"#REFERENCE!\". Det er alle henvisninger til rækken lige over underskrifts rækken. F.eks når jeg ser i b41 så har jeg henvisningen $I40 og denne henvisning ryger når sletter de tomme rækker før du kopierer.
Du indsætter en overskriftslinie for meget til sidst. D.v.s. når du går fra sidste kundenr til en ikke udfyldt.
Her udover skal jeg fortælle at cellerne a3-p41 er formateret med rammer. Det betyder at når du f.eks indersætter 7 overskrifts/underskrifts rækker så er cellerne til og med række 48 godt nok blanke men er stadig formateret med streger og det er not så godt. Som jeg ser det skal du slette rækker i stedet for at cleare – men hvad ved jeg? Ellers en snild lille kode.
Hej Preben den sætter ikke en eksta linie ind her hos mig, når jeg tester den, men nu har jeg jo ikke set dit regneark. Formatering klares ved i sidste linie af makroen at erstatte: Selection.ClearContents med Selection.Clear
If Cells(n, 1).Value <> Cells(n - 1, 1).Value Then Underskrift = Underskrift + 1 Rows(n).Insert Shift:=xlDown Rows(Underskrift).Copy Rows(n).Select ActiveSheet.Paste Rows(n + 1).Insert Shift:=xlDown Rows(Overskrift).Copy Rows(n + 1).Select ActiveSheet.Paste n = n + 2 x = x + 2 Underskrift = Underskrift + 1 End If Next n
\'Finder sidste brugte række ActiveCell.SpecialCells(xlLastCell).Select \'Gå en celle op ActiveCell.Offset(-1, 0).Range(\"A1\").Select
\'Vælger området fra sidste celle med data til sidste celle -1 og sletter det Range(Cells(række + x, 1), Cells(ActiveCell.Row, ActiveCell.Column)).Select Selection.EntireRow.Delete Application.CutCopyMode = False
Jo, statuslinien er række 41 og sidste linie som skal formateres er linie 40, MEN efterhånden som der bliver indsat over-/underskrifter rykker statuslinien(41) jo nedad, ligesom linierne som skal formateres rykker nedad og i de tilfælde hvor der er mange linier rykker de forbi række 41.
Lidt mere - du ta'r jo godt nok hånd om dette når du plusser x og fast1, efterhånden som du indsætter linier. Men det er som om udtrykket "For x = 6 To fast1" holder fast ved den oprindelige værdi af fast1, mens x godt nok justeres (ellers ville der jo gå kage i formateringen)- eller hvad?
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.
