22. november 2004 - 20:54Der er
10 kommentarer og 2 løsninger
Indsæt række nedenunder med formler fra række ovenfor via VBA
Hej
Jeg har et ark, hvor jeg gerne vil have Excel til at indsætte en række - inkl. formler og formater - nedenunder den række der arbejdes i - når fx feltet (L, rækkenr)(fx L2) har en bestemt værdi (fx 1).
Jeg har fundet denne kode men kan ikke helt få det til at fungere:
Sub TilføjRække() R = Range("L300").End(xlUp).Row Range("A" & R - 1).Select ActiveCell.EntireRow.Insert Shift:=xlDown Range("A" & R - 1).Select For I = 1 To 11 If ActiveCell.Offset(-1, I).HasFormula Then ActiveCell.Offset(-1, I).AutoFill _ Destination:=Range(ActiveCell.Offset(-1, I), ActiveCell.Offset(0, I)) _ , Type:=xlFillDefault End If Next End Sub
Nu indsætter den en tom linie neden under den række du står i, og tager formler med ned.
Du skal selv køre makroen
Sub TilføjRække() ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown R = ActiveCell.Row Range("A" & R + 1).Select For I = 1 To 11 If ActiveCell.Offset(-1, I).HasFormula Then ActiveCell.Offset(-1, I).AutoFill _ Destination:=Range(ActiveCell.Offset(-1, I), ActiveCell.Offset(0, I)) _ , Type:=xlFillDefault End If Next End Sub
Hej Kabbak Du kan jo se, at jeg har fundet det fra et af dine tidligere svar. Men den kopier ikke formlerne i kolonne A. Dernæst - man kan altså ikke aktivere makroen ved at værdien i en celle forandre sig, eller?
Højreklik på faneblade og vælg "Vis programkode" og indsæt følgende:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Range("L" & ActiveCell.Row) = 1 Then Range("L" & ActiveCell.Row) = 0 'ellers bliver den bare ved og ved og ved... TilføjRække End If
End Sub
BEMÆRK at hvis du står i f.eks. L2 og skriver 1 og så flytter til L3 (sker f.eks. ved tryk på Enter) så er Activecell L3 og så fanger programmet IKKE at L2 er ændret til 1. Hvis du derefter flytter op til L2 igen, så fanger programmet 1-tallet og udfører TilføjRækker.
Du kan evt. overveje i stedet at checke alle tal i L om de er 1.
jeg er enig med sjap, jeg ville ikke turde at gøre den automatisk, men nu er koden rettet.
Sub TilføjRække() ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown r = ActiveCell.Row Rows(r).Copy Range("A" & r + 1).PasteSpecial Paste:=xlFormats, Operation:=xlNone ' For I = 0 To 13 If ActiveCell.Offset(-1, I).HasFormula Then ActiveCell.Offset(-1, I).AutoFill _ Destination:=Range(ActiveCell.Offset(-1, I), ActiveCell.Offset(0, I)) _ , Type:=xlFillDefault End If Next End Sub
Tusind tak - begge. Jeg kan godt se, at det giver problemer med denne automatik - hvis brugeren 'kommer til' at skrive i L(nr) uhensigtmæssigt. Måske burde jeg checke sidste L(nr) som er udfyldt. Men det løser principielt ikke problemet - så kan jeg risikere at få 'sjove' tomme rækker?
L(nr) bliver udfyldt på baggrund af indtastninger fra brugeren i den pågældende række. Nogle brugere skal bruge 30 rækker, andre op til 200 rækker.
Den bedste løsning er nok, at brugeren ved igangsætning af arket, svarer på hvor mange rækker vedkommende har brug for 'ca' - evt via en dialogboks. Det kan så aktivere en kopiering efter et defineret behov.
(Det er udelukkende for at spare plads i den samlede projektmappe, samt ved udskift af arket).
Tusind tak for input. Hvem skal jeg dog honorere. Må jeg dele? Kabbak 30 og Sjap 15? Hvis jeg må, så giv et svar.
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.
