Zkopírujte data s datem mezi dvěma definovanými daty do nového listu pomocí VBA

Anonim

V tomto článku vytvoříme makro pro extrahování dat z listu nezpracovaných dat do nového listu na základě zadaného období.

Nezpracovaná data se skládají ze tří sloupců. První sloupec obsahuje data, druhý sloupec obsahuje jména agentů a třetí sloupec obsahuje počty prodejů realizovaných agentem k danému datu.

Před spuštěním makra jsou od uživatele vyžadovány dva vstupy. Uživatel musí definovat počáteční a koncové datum. Na základě zadaných dat makro extrahuje data mezi definovaným rozsahem dat do nového listu.

Po zadání počátečního a koncového data musí uživatel makro spustit kliknutím na tlačítko „Odeslat“.

Při spuštění makra třídí data v listu „RawData“ podle sloupce data a extrahuje data podle zadaného období do nově vloženého listu.

Logické vysvětlení

Makro vstupuje pro data zahájení a ukončení z buněk J8 a J9. Toto makro nejprve seřadí data v listu „RawData“ na základě sloupce A ve vzestupném pořadí. Data jsme seřadili podle hodnot data, abychom po použití filtru pro definovaný rozsah mohli data zkopírovat do jednoho rozsahu.

Po seřazení dat na ně naneste filtr. Použitý filtr je založen na dvou podmínkách, první podmínkou je, že hodnota ve sloupci A by měla být větší nebo rovna počátečnímu datu, a druhou podmínkou je, že hodnota ve sloupci A by měla být menší nebo rovna koncovému datu.

Po použití filtru se vloží nový list a zkopírovaná data se do něj zkopírují a vloží.

Vysvětlení kódu

Rozsah ("A1"). Klíč CurrentRegion.Sort1: = Rozsah ("A1"), pořadí1: = xlAscending, záhlaví: = xlAno

Výše uvedený kód slouží k třídění dat v definovaném rozsahu. Key1 určuje sloupec, na základě kterého budou data tříděna. Třídění objednávky zajišťuje order1. Vzestupné pořadí jsme již definovali. K definování sestupného pořadí lze použít konstantu xlDescending. Záhlaví se používá k určení, zda rozsah dat obsahuje záhlaví.

Rozsah ("A1"). Pole CurrentRegion.AutoFilter: = 1, Criteria1: = "> =" & StartDate, Operator: = xlAnd, Criteria2: = "<=" & EndDate

Výše uvedený kód se používá k použití filtru v rozsahu dat. Pole 1 určuje číslo sloupce, na které bude použit filtr. Kritéria 1 a kritéria 2 definují podmínky, na základě kterých budou data filtrována. Operátor určuje operátora, který bude použit mezi dvěma podmínkami.

Worksheets.Add after: = Pracovní listy (Worksheets.Count)

Výše uvedený kód se používá k vložení nového listu za poslední list v sešitu.

Kódy lze snadno pochopit, protože jsem spolu s kódy vložil komentáře do makra.

Pro kód prosím postupujte níže

 Sub CopyDataBasedOnDate () 'Deaktivace aktualizací obrazovky Application.ScreenUpdating = False' Deklarace dvou proměnných datového typu Dim StartDate, EndDate As Date 'Deklarace proměnné pro objekt listu Dim MainWorksheet As Worksheet' Inicializace proměnných data s počátečním datem z buňky J8 'a datum ukončení z buňky J9 listu „Makro“ Počáteční datum = Listy („Makro“). Rozsah („J8“). Hodnota Koncové datum = Listy („Makro“). Rozsah („J9“). Hodnota „Inicializace objektu listu pomocí“ RawData "list Nastavit MainWorksheet = Pracovní listy (" RawData ") 'Aktivace objektu listu MainWorksheet.Activate' Třídění dat podle data ve sloupci A ve vzestupném pořadí Rozsah („ A1 “). CurrentRegion.Sort _ key1: = Rozsah („ A1 "), order1: = xlAscending, _ Header: = xlYes 'Filtrujte data podle časového období mezi počátečním datem a koncovým datem (" A1 "). Pole CurrentRegion.AutoFilter: = 1, Criteria1: = _"> = " & StartDate, Operator: = xlAnd, Criteria2: = "<=" & EndDate 'Zkopírujte data filtru ActiveSheet.AutoFilter.Range.Copy' Vkládání nového wor ksheet za posledním listem v sešitech Pracovní listy.Přidat po: = Listy (Worksheets.Count) 'Vkládání zkopírovaných dat ActiveSheet.Paste' Automatické přizpůsobení velikosti vybraných sloupců Selection.Columns.AutoFit Rozsah ("A1"). Vyberte ' Aktivace listu „RawData“ MainWorksheet.Activate 'Odebrání filtru z listu, který jsme použili dříve Selection.AutoFilter Sheets („Makro“). Aktivovat End Sub 

Pokud se vám tento blog líbil, sdílejte ho se svými přáteli na Facebooku. Také nás můžete sledovat na Twitteru a Facebooku.

Rádi bychom od vás slyšeli, dejte nám vědět, jak můžeme zlepšit naši práci a zlepšit ji pro vás. Napište nám na e -mail