24. december 2007 - 12:18Der er
11 kommentarer og 1 løsning
indsætte 4 linier, incl formler
JEg har idag et ark der er opdelt i grupper af 4 linier.
Jeg kunne godt tænke mig en makro der indsætter en gruppe der 4 linier som der allerede er .
der er formler i kolonne E som meget gerne må kopieres med til den nye gruppe. Den nye gruppe skal sættes ind under den gruppe man står i.
udfordringen består i at der kun står noget i den øverste linie i kol A i gruppen. Så hvis man står i linie 2,3,4, så skal den enten exit sub eller også skal den finde den linie ovenfor som har et tal i kol A.
Når der sættes en ny gruppe på 4 linier ind, må den eksisterende gruppe ikke blive "splittet"
Kan det lade sig gøre.
De 4 linier som bliver sat ind må meget gerne blive kopieret fra linierne 2-4, da jeg har "masteren" til gruppen liggende her.
Arket ser ca således ud:
A B C D E 10 1000 formel 11 formel 12 formel 13 formel
Sub Makro1() If ActiveCell.Row < 10 Then Exit Sub If ActiveCell.Column <> 1 Then Cells(ActiveCell.Row, 1).Select If Cells(ActiveCell.Row, 1) = "" Then Selection.End(xlUp).Select End If Range(ActiveCell.Address).Resize(4, 5).EntireRow.Insert 'Select adr = Selection.Address Range("A2:E5").Copy Range(adr) ActiveCell.Select End Sub
lige lidt opklarende: 1. hvordan skal din makro aktiveres ? 2. skal der indsættes et tilfældigt(/uendeligt) antal grupper 3. dine formler i kol.E referer de indenfor gruppen eller? 4. skal værdierne i kol.A opdateres
makroen virker som jeg bad om, mange tak for det. Men jeg fik ikke lige tænkt problem stillingen helt igennem. Da man sagtens kan stå i en gruppe som ikke har et tal i linie 1.
Men gruppen er ALTID markeret med en ramme. Kan man så istedet for at kontrollere om kolonne A er tom, kontrollere om der er en ramme i "toppen" af cellen.
Hvis der er det skal den lave den nye gruppe. Hvis ikke skal den exit sub - eller finde den først komne linie ovenfor som har den formatering og så indsætte gruppen. Som det makroen allerede gør.
hairline og excels gitterlinier har tilsyneladende samme index så checker på colorindex i stedet prøv :
Sub Makro1() If ActiveCell.Row < 10 Then Exit Sub If ActiveCell.Column <> 1 Then Cells(ActiveCell.Row, 1).Select If ActiveCell.Borders(xlEdgeTop).ColorIndex = -4105 Then GoTo ud: For t = 1 To 4 ActiveCell.Offset(-1, 0).Select If ActiveCell.Borders(xlEdgeTop).ColorIndex = -4105 Then Exit For Next ud: Range(ActiveCell.Address).Resize(4, 5).EntireRow.Insert adr = Selection.Address Range("A2:E5").Copy Range(adr) ActiveCell.Select End Sub
Sub Makro1() If ActiveCell.Row < 10 Then Exit Sub If ActiveCell.Column <> 1 Then Cells(ActiveCell.Row, 1).Select If ActiveCell.Borders(xlEdgeTop).ColorIndex = -4105 Then GoTo ud: For t = 1 To 4 ActiveCell.Offset(-1, 0).Select If ActiveCell.Borders(xlEdgeTop).ColorIndex = -4105 Then Exit For Next ud: Range(ActiveCell.Address).Resize(4, 5).EntireRow.Insert adr = Selection.Address Range("A2:E5").Copy Range(adr) Range(adr).Resize(4, 5).Select With Selection .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlEdgeRight).Weight = xlThin End With ActiveCell.Select End Sub
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.
