15. juli 2014 - 13:29Der er
26 kommentarer og 1 løsning
Automatisk Fill Down af formler i kolonner
Jeg har nogle bestemte kolonner (fra Y til og med AE) som indeholder bestemte formler, som jeg gerne vil have kopieret ned indtil der ikke er mere data i X antal rækker. Antallet af rækker med data vil skifte ugentligt og området for de skiftende data er fra kolonne A til og med X mens antallet af rækker nedad som sagt vil ændres.
Kolonnerne med formler ser således ud (Y, Z, AA, AB, AC, AD og AE og de starter alle fra række 6): - Y: =WEEKNUM(K6;2) - Z: =VLOOKUP(S6;Wagendetails!F$2:G$310;2;FALSE) - AA: =VLOOKUP(I6;Wagendetails!B$2:D$420;2;FALSE) - AB: =VLOOKUP(I6;Wagendetails!B$2:D$420;3;FALSE) - AC: =IF(V6=0;AB6;V6+AB6) - AD: =VLOOKUP(C6;Relationen!A$2:C$550;2;FALSE) - AE: =VLOOKUP(D6;Relationen!E$2:F$10;2;FALSE) Nedenstående tre koder er dem jeg har forsøgt at bruge - indtil videre uden held: Sub CMRDatenDSc_Button2_Click() If Not Intersect(Target, Range("A:X")) Is Nothing Then 'This makes the code execute only when a value in column C is changed Application.EnableEvents = False 'This prevents infinate loop lastrow = Range("A1048576:X1048576").End(xlUp).Row Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault Application.EnableEvents = True End If End Sub Eller Sub CMRDatenDSc_Button2_Click() Private Sub Worksheet_Change(ByVal Target As Range) lastrow = Range("A1048576:X1048576").End(xlUp).Row Application.EnableEvents = False 'This prevents infinate loop Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault Application.EnableEvents = True End Sub Eller Sub CMRDatenDSc_Button2_Click() a = Cells(A:X).End(xlUp).Row b = "Y6:AE6" & a Selection.AutoFill Destination:=Range(b) End Sub
Jeg kan simpelthen ikke finde ud af hvor jeg har lavet en fejl så jeg vil sætte pris enhver hjælp.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("A:X")) Is Nothing Then 'This makes the code execute only when a value in column A:X is changed Application.EnableEvents = False 'This prevents infinate loop lastrow = Range("A1048576:X1048576").End(xlUp).Row Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault Application.EnableEvents = True End If End Sub
If Not Intersect(Target, Range("A:X")) Is Nothing Then 'This makes the code execute only when a value in column A:X is changed Application.EnableEvents = False 'This prevents infinate loop lastrow = Range("A1048576:X1048576").End(xlUp).Row Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault Application.EnableEvents = True End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo ErrorHandle
If Not Intersect(Target, Range("A:X")) Is Nothing Then 'Makro køres ved ændring i A:X kolonner Application.EnableEvents = False 'For at undgå loop lastrow = Range("A1048576:X1048576").End(xlUp).Row 'Sidste række i A kolonnen Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault
BeforeExit: Application.EnableEvents = True End If Exit Sub
'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit
End Sub
Hvis du vil aktiverer med en knap:
Sub CMRDatenDSc_Button2_Click() On Error GoTo ErrorHandle
Application.EnableEvents = False 'For at undgå loop lastrow = Range("A1048576:X1048576").End(xlUp).Row 'Sidste række i A kolonnen Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault
BeforeExit: Application.EnableEvents = True End If Exit Sub
'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit
Koden virker nu helt perfekt. Kan du forklare hvorfor If Not Intersect ikke skal med koden for knappen, når antallet af rækker ændres for kolonne A til X?
Jeg har fundet ud af at de ugentlige data jeg sætter ind i regnearket nogle gange også er mindre end den forrige uges data. Dvs. at jeg nogle gange må slette de overskydende celler i kolonne Y til AE, fordi der ikke er tilsvarende data i de resterende rækker/kolonner (altså fra sidste række med data i de faste kolonner A til X).
Kan din formel justeres til ikke bare at fylde formler nedad men i forhold til de rækker af data der sættes in under kolonne A til X?
Alle räkker starter fra räkke 6, hvor jeg fra rökke 6 og nedad indsätter data manuelt (copy/paste) - og det er saa altid fra kolonne A til og med X. Der er saa faste formler fra kolonne X til AE, som jeg saa vil have fyldt nedad ud fra hvor mange räkker med data, der er sat ind.
Sub CMRDatenDSc_Button2_Click() On Error GoTo ErrorHandle
Application.EnableEvents = False 'For at undgå loop
Range("Y7:AE1048576").Clear 'Sletter gamle formler
lastrow = Range("A1048576:X1048576").End(xlUp).Row 'Sidste række i A kolonnen Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault
BeforeExit: Application.EnableEvents = True Exit Sub
'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit
End Sub
Koden bliver lidt langsommere. Ret evt. Y7:AE1048576 til din max antal rækker.
Sub CMRDatenDSc_Button2_Click() On Error GoTo ErrorHandle
Application.EnableEvents = False 'For at undgå loop
Range("Y1,Y2, Y3, Y4").Value = "Tom" 'Skriver miderlig tekst lastrow = Range("Y1048576").End(xlUp).Row 'Sidste række i Y kolonnen Range("Y7:AE" & lastrow).Clear 'Sletter gamle formler Range("Y1,Y2, Y3, Y4").Clear 'Sletter miderlig tekst
lastrow = Range("A1048576:X1048576").End(xlUp).Row 'Sidste række i A:X kolonnen Range("Y6:AE6").AutoFill Destination:=Range("Y6:AE" & lastrow), Type:=xlFillDefault
BeforeExit: Application.EnableEvents = True Exit Sub
'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit
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.
