18. marts 2012 - 08:27Der er
23 kommentarer og 1 løsning
Gentage makro i regneark
Bruger flg. kode til at flytte linjer fra ark1 til ark2, hvis der forekommer et "x" i kolonne l på ark1. Hvordan får jeg makroen til at køre hele kol "L" igennem indtil alle rækker er "afsøgt"?
For Each c In Range("L1:L100").Cells If c.Value = "x" Then c.EntireRow.Select Selection.Cut Sheets(2).Select Range("L1").Select Cells(65000, ActiveCell.Column).End(xlUp).Offset(1, -11).Select ActiveSheet.Paste Sheets(1).Select End If Next c
Application.ScreenUpdating = True
BeforeExit: Application.ScreenUpdating = True
Exit Sub 'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit End Sub
For Each c In Range("L1:L100").Cells If c.Value = "x" Then c.EntireRow.Select Selection.Cut Sheets(2).Select Range("L1").Select Cells(65000, ActiveCell.Column).End(xlUp).Offset(1, -11).Select ActiveSheet.Paste Sheets(1).Select End If Next c
Application.ScreenUpdating = True
BeforeExit: Application.ScreenUpdating = True
Exit Sub 'Her havner vi ved programfejl ErrorHandle: Resume BeforeExit 'Dirigerer tilbage til BeforeExit End Sub
Jeg har koblet store-mortens og lalocins forslag med en for i next loop i stedet for en for each loop. Det er vigtigt at der også er data i kolonne A i sheet 2, da denne bestemmer hvor linje indsættes.
Sub testTHIS()
Dim MyRange As Range Dim r As Integer, i As Integer
Prøv denne: Jeg brugte: "Sheets(2).Select" i stedet for "Sheets("2").Select" Men det kræver at det vittelig er Ark2 der er døbt "2"
Minus: sletter ikke rækker på Ark1
Sub test2() On Error GoTo ErrorHandle
Application.ScreenUpdating = False
For Each c In Range("L1:L100").Cells If c.Value = "x" Then c.EntireRow.Select Selection.Cut Sheets("2").Select Range("L1").Select Cells(65000, ActiveCell.Column).End(xlUp).Offset(1, -11).Select ActiveSheet.Paste Sheets("1").Select End If Next c
Application.ScreenUpdating = True
Beforeexit: Application.ScreenUpdating = True
Exit Sub 'Her havner vi ved programfejl ErrorHandle: Resume Beforeexit 'Dirigerer tilbage til BeforeExit End Sub
Set c = Range("L" & i) If c.Value = "x" Then c.EntireRow.Select Selection.Cut Sheets("2").Select Range("L1").Select Cells(65000, ActiveCell.Column).End(xlUp).Offset(1, -11).Select ActiveSheet.Paste Sheets("1").Select Selection.Delete Shift:=xlUp End If Next
Den sidste du sendte virker, men den tager ikke alle forekomster(linjer) af "x" med. Fint med at lade kol l bestemme indsætningspunkt for flyttede data, da der jo altid vil være data i den række.
Nej, det havde jeg i første omgang (kan man gøre noget ved det?).
Hvis jeg "kører" makroen flere gange, bliver alle forekomster flyttet. Der er ikke rigtig noget mønster i, hvor mange der bliver taget med ved hver kørsel.
øh - det må du lige forklare eller hvad gør jeg. Jeg mener jeg prøvede, at stille alle efter hinanden og der tog den heller ikke alle med? Ikke helt sikker.
Store-Morten anvender en "For i=1 to Start .....Next løkke, til at gennemløbe rækkerne i kolonne L.
Hvis eksempelvis i =10 så tjekker koden værdien af L10 og hvis det er et "x" så flyttes rækken til det andet ark og linjen slettes. Men hermed bliver række 11 jo til række 10. Når koden når til Next så tæller i op til 11 og værdien i L11 tjekkes, men hvis den tidligere række 11 indeholdt et "x" så bliver den jo ikke tjekket, da den nu er række 10 og dermed springes der over.
Sub Flyt_1til2() Dim Start As Integer, i As Integer 'Skærmopdatering fra Application.ScreenUpdating = False 'Ved fejl gå til On Error GoTo ErrorHandler
Sheets("1").Select 'Find sidste udfyldte celle i kolonne L Start = Range("L65536").End(xlUp).Row
'Kør løkken fra sidste udfyldte celle i kolonne L til række 1 For i = Start To 1 Step -1
Set c = Range("L" & i) If c.Value = "x" Or c.Value = "X" Then c.EntireRow.Select Selection.Cut Sheets("2").Select Range("L1").Select Cells(65000, ActiveCell.Column).End(xlUp).Offset(1, -11).Select ActiveSheet.Paste Sheets("1").Select Selection.Delete Shift:=xlUp End If Next 'Skærmopdatering til Application.ScreenUpdating = True
Beforeexit: 'Ved fejl sættes 'Skærmopdatering til Application.ScreenUpdating = True 'C tømmes Set c = Nothing 'Før Subben forlades Exit Sub
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.