NYARCH skriver
Jeg vil ha Excel til å kopiere en hel rad til et nytt Excel-regneark basert på en celleoppføring. For eksempel har jeg data i cellene A8: AG8, jeg vil ha Excel til å kopiere hele raden til ark "a" hvis verdien i H8 er "ir", og ark "b" hvis verdien i H8 er "RR". Den mest kompliserte delen og ikke bare kopiert, jeg trenger den kopiert til neste tomme rad på regnearket. Av de 150 rader eller så blir bare omtrent 15 av hver type kopiert til et nytt ark.
MrExcel vil tildele 50 bonuspoeng til alle lesere som husker Lotus Magazine-artikkelen som tilbyr 10 gode tips, der tips nr. 4 var "Bruk End-tasten til å flytte til slutten av et område". Hvis du går tilbake til Lotus-dager, kan du plassere cellepekeren hvor som helst i en datablokk, trykke END og deretter ned, og cellepekeren vil kjøre til slutten av området. Excel har lignende funksjonalitet, VBA har lignende funksjonalitet, og dette er nøkkelen til å finne den siste raden med data på et ark.
VBA-teknikken er å bruke End (xlDown) til å simulere End + Down-tasten eller End (xlUp) for å simulere End + Up-tasten. Ved å trykke på denne tastesekvensen flyttes cellepekeren til neste kant av et sammenhengende dataområde. Tenk deg at det er verdier i A1: A10 og A20: A30. Start i A1. Trykk på End + Down og cellepekeren flyttes til A10. Trykk på End + Down, og gå til A20, som er den øverste kanten av det neste sammenhengende dataområdet. Trykk på End + Down så går du til A30. Jeg er faktisk tapt hvordan jeg skal forklare denne oppførselen på enkel engelsk. Bare prøv det, så ser du hvordan det fungerer.
Trikset jeg bruker er å starte ved kolonne A i siste rad i regnearket og deretter trykke End + Up. Dette tar meg til siste rad med data. Jeg vet da å bruke neste rad ned som en tom rad.
Her er en makro for å løse ukens problem. Ja, du kan absolutt gjøre dette mer elegant med et autofilter. Dataene er for øyeblikket på Sheet1, med overskriftene i rad 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 SubGitt at Excel 2007 har mer enn 65 536 rader, kan du bruke denne makroen slik at den er fremoverkompatibel. Merk at jeg bruker CELLS (rad, 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 SubHvis du vil ha tips om hvordan du bruker en makro, kan du se Introduksjon til Excel VBA Editor.
