15. juni 2008 - 16:04Der er
6 kommentarer og 1 løsning
finde en linje med tal og kopiere denne+de 3 næste tomme linier
Jeg har et ark med ca 4000 linjer.
I det ark står der nogle gange et tal i kolonne A.
Jeg kunne godt tænke mig at en makro løber linjerne igennem og gør følgende:
1. Finder den første linje der indeholder et tail i kolonne A 2. kopiere denne linje til et nyt ark 3. finder og kopiere de næste tre linjer som er tomme i kolonne A, neden under linjen med tallet. 4. går videre til den næste linje med et tal i kolonne A og gentager ovenstående.
I det ark hvor linjerne bliver kopieret over i , må der meget gerne være en tom linje mellem hver gruppe der bliver kopieret over, så gruperne er lidt lettere at overskue.
Denne side indeholder artikler med forskellige perspektiver på Identity & Access Management i private og offentlige organisationer. Artiklerne behandler aktuelle IAM-emner og leveres af producenter, rådgivere og implementeringspartnere.
Sub KopierLidt() Application.ScreenUpdating = False Sheets(1).Select For Each c In Range("a:a").Cells If c.Value <> "" Then c.EntireRow.Select ActiveCell.Rows("1:4").EntireRow.Select Selection.Copy Sheets(2).Select If IsEmpty(Range("a1")) Then Range("a1").Select ActiveSheet.Paste Else Range("a65500").Select Selection.End(xlUp).Offset(5, 0).Select ActiveSheet.Paste End If Sheets(1).Select End If Next c Range("a1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Ja, den gør næsten det jeg gerne vil have den til. Jeg har rettet lidt i koden fordi at den kun skal kopier noget hvis det der står i kolonne A er et tal.
Nu har jeg bare lige et problem. Koden kopierer linjen med tal i celle A + de 3 næste linjer. Men den skal istedet kopiere linjen med tal + de 3 næste linjer som er TOMME i celle A. (det kan godt være linjen lige under, men ikke den næste, da den indeholder en værdi, men så igen de 2 næste linjer)
Den skal altså altid kopiere 4 liner.
Sub KopierLidt() Application.ScreenUpdating = False Sheets(1).Select For Each c In Range("a:a").Cells taltjek = Application.WorksheetFunction.IsNumber(c) If taltjek = True Then 'If c.Value <> "" Then c.EntireRow.Select ActiveCell.Rows("1:4").EntireRow.Select Selection.Copy Sheets(2).Select If IsEmpty(Range("a1")) Then Range("a1").Select ActiveSheet.Paste 'End If Else Range("a65500").Select Selection.End(xlUp).Offset(5, 0).Select ActiveSheet.Paste End If Sheets(1).Select End If Next c Range("a1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Den skal altid kopiere 4 linier. Dette skyldes at der altid er minimum 3 linier nedenunder inden der kommer et nyt tal, så det problem du har vist ovenfor undergår vi heldigvis.
Så det er den aktuelle linje som har noget i celle A + de 3 næste linjer som er tomme i celle a
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.
