NYARCH skriver
Jeg vil have Excel til at kopiere en hel række til et nyt Excel-regneark baseret på en celleindgang. For eksempel har jeg data i cellerne A8: AG8, jeg vil have Excel til at kopiere hele rækken til ark "a", hvis værdien i H8 er "ir" og ark "b", hvis værdien i H8 er "RR". Den mest komplicerede del og ikke kun kopieret, jeg har brug for den kopieret til den næste tomme række på regnearket. Af de cirka 150 rækker kopieres kun ca. 15 af hver type til et nyt ark.
MrExcel tildeler 50 bonuspoint til enhver læser, der husker artiklen i Lotus Magazine, der tilbyder 10 gode tip, hvor tip nr. 4 var "Brug End-tasten til at flytte til slutningen af en rækkevidde". Hvis vi går tilbage til Lotus 'dage, kunne du placere cellepegeren hvor som helst i en datablok, trykke END og derefter ned, og cellemarkøren kørte til slutningen af intervallet. Excel har lignende funktionalitet, VBA har lignende funktionalitet, og dette er nøglen til at finde den sidste række data på et ark.
VBA-teknikken er at bruge End (xlDown) til at simulere End + Down-tasten eller End (xlUp) til at simulere End + Up-tasten. Ved at trykke på denne tastesekvens flyttes cellemarkøren til den næste kant af et sammenhængende dataområde. Forestil dig, at der er værdier i A1: A10 og A20: A30. Start i A1. Hit End + Down og cellemarkøren flyttes til A10. Hit End + Down, og du går til A20, som er den øverste kant af det næste sammenhængende dataområde. Hit End + Down og du vil gå til A30. Jeg har faktisk mistet, hvordan jeg forklarer denne adfærd på enkel engelsk. Bare prøv det, så ser du, hvordan det fungerer.
Det trick, jeg bruger, er at starte ved kolonne A i sidste række i regnearket og derefter trykke på End + Up. Dette fører mig til den sidste række med data. Jeg ved så at bruge den næste række ned som en tom række.
Her er en makrofakt til at løse denne uges problem. Ja, du kunne helt sikkert gøre dette mere elegant med et autofilter. Dataene er i øjeblikket på Ark1 med overskrifter i række 2.
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Range("A65536").End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Range("H" & x).Value If ThisValue = "ir" Then Range("A" & x & ":AG" & x).Copy Sheets("a").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Range("A" & x & ":AG" & x).Copy Sheets("b").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubDa Excel 2007 har mere end 65.536 rækker, kan du bruge denne makro, så den er fremadkompatibel. Bemærk, at jeg bruger CELLS (række, kolonne) i stedet for RANGE her:
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Cells(x, 8).Value If ThisValue = "ir" Then Cells(x, 1).Resize(1, 33).Copy Sheets("a").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Cells(x, 1).Resize(1, 33).Copy Sheets("b").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubFor tip til, hvordan du bruger en makro, se Introduktion til Excel VBA Editor.
