NYARCH píše
Chci mít Excel zkopírovat celý řádek do nového listu aplikace Excel na základě vstupu do buňky. Například mám data v buňkách A8: AG8, chci, aby Excel zkopíroval celý řádek na list „a“, pokud je hodnota v H8 „ir“, a list „b“, pokud je hodnota v H8 „RR“. Nejkomplikovanější část a nejen kopírovaná, potřebuji ji zkopírovat do dalšího prázdného řádku v listu. Ze zhruba 150 řádků bude na nový list skutečně zkopírováno pouze asi 15 každého typu.
MrExcel udělí 50 bonusových bodů každému čtenáři, který si vzpomene na článek Lotus Magazine nabízející 10 skvělých tipů, kde tip č. 4 byl „Použijte klávesu End k přesunu na konec rozsahu“. Když se vrátíme do doby Lotusu, můžete buněčný ukazatel umístit kamkoli do bloku dat, stisknout END a potom dolů a ukazatel buňky by se dostal na konec rozsahu. Excel má podobné funkce, VBA má podobné funkce a to je klíč k nalezení poslední řady dat na listu.
Technika VBA je použít End (xlDown) k simulaci klávesy End + Down nebo End (xlUp) k simulaci klávesy End + Up. Stisknutím této sekvence kláves přesunete ukazatel buňky na další hranu souvislého rozsahu dat. Představte si, že existují hodnoty v A1: A10 a A20: A30. Začněte v A1. Stiskněte End + Down a ukazatel buňky se přesune na A10. Stiskněte End + Down a přejdete na A20, což je horní hrana dalšího souvislého rozsahu dat. Stiskněte End + Down a přejdete na A30. Vlastně jsem na rozpacích, jak vysvětlit toto chování jednoduchou angličtinou. Vyzkoušejte to a uvidíte, jak to funguje.
Trik, který používám, je začít ve sloupci A v posledním řádku tabulky a poté stisknout End + Up. Tím se dostanu na poslední řádek s daty. Pak vím, že použiji další řádek dolů jako prázdný řádek.
Zde je makro hrubou silou k vyřešení problému z tohoto týdne. Ano, s automatickým filtrem byste to mohli udělat elegantněji. Data jsou aktuálně na listu 1 s nadpisy v řádku 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 SubVzhledem k tomu, že Excel 2007 má více než 65 536 řádků, můžete toto makro použít, aby bylo kompatibilní dopředu. Všimněte si, že místo RANGE zde používám CELLS (Row, Column):
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 SubTipy, jak používat makro, najdete v části Představení editoru Excel VBA.
