Sadaliet Excel lapu vairākos failos, pamatojoties uz kolonnu, izmantojot VBA

Vai jums ir lieli dati par Excel lapu un šī lapa ir jāizplata vairākās lapās, pamatojoties uz dažiem slejas datiem? Tas ir ļoti vienkāršs uzdevums, bet laikietilpīgs.

Piemēram, man ir šie dati. Šiem datiem ir sleja ar nosaukumu Datums, rakstnieks un Nosaukums. Rakstnieka slejā ir attiecīgā nosaukuma rakstnieka vārds. Es vēlos iegūt katra rakstnieka datus atsevišķās lapās.

Lai to izdarītu manuāli, man ir jādara šādi:

Filtrējiet vienu nosaukumu
Kopējiet filtrētos datus
Pievienojiet lapu
Ielīmējiet datus
Pārdēvējiet lapu
Atkārtojiet visas iepriekš minētās 5 darbības katram.

Šajā piemērā man ir tikai trīs vārdi. Iedomājieties, ja jums būtu 100 vārdu. Kā jūs sadalītu datus dažādās lapās? Tas prasīs daudz laika, un tas aizplūdīs arī jūs.
Lai automatizētu iepriekš minēto lapu sadalīšanas vairākās lapās procesu, rīkojieties šādi.

Nospiediet Alt+F11. Tas atvērs Excel VB redaktoru
Pievienot jaunu moduli
Kopēt zem koda modulī.

 Sub SplitIntoSheets () Izmantojot lietojumprogrammu .ScreenUpdating = False .DisplayAlerts = False End with ThisWorkbook. Activate Sheet1.Activate 'Clearing filter ifAt On Error Resume Next Sheet1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long' skaitot pēdējo izmantoto rindu lstRow = Cells (Rows.Count, 1) .End (xlUp). Rindas Dim unikāls Kā diapazons Dim clm Kā virkne, clmNo tik ilgi ieslēgta kļūda GoTo hendler clm = Application.InputBox ("No kuras kolonnas vēlaties izveidot failus" & vbCrLf & "Piem. " uniques = RemoveDuplicates (unikāli) Zvanīt CreateSheets (unikāli, clmNo) Izmantojot lietojumprogrammu .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Labi darīts!" Iziet no apakšdatiem. ShowAllData apstrādātājs: ar lietojumprogrammu .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Funkcija RemoveDuplicates (unikāls kā diapazons) Kā diapazons ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets ("uniques"). Activate On Error GoTo 0 uniques.Copy Cells (2, 1) .Aktivizēt ActiveCell.PasteSpecial xlPasteValues Range ("A1") .Value = "uniques" Dim lstRow As Long lstRow = Šūnas (Rows.Count, 1) .End (xlUp) .Row Range ("A2: A" & lstRow). Atlasiet ActiveSheet.Range (Selection.Address) .RemoveDuplicates Columns : = 1, galvene: = xlNo lstRow = Šūnas (Rows.Count, 1) .End (xlUp). Rindu kopa RemoveDuplicates = Diapazons ("A2: A" & lstRow) beigu funkcija Sub CreateSheets (unikāls kā diapazons, clmNo tik ilgi) Dim lstClm tik ilgi Dim lstRow cik ilgi katram unikālajam unikālajam loksnei 1. Aktivizēt lstRow = Cells (Rows.Count, 1). End (xlUp) .Row lstClm = Cells (1, Columns.Count) .End (xlToLeft) .Column Dim datu iestatīšana kā diapazona kopa xlUp). Rinda lstClm = Šūnas (1, Columns.Count). End (xlToLeft). Kolonnas atkļūdošana. Drukāt lstRow; lstClm Set dataSet = Diapazons (šūnas (1, 1), šūnas (lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next unikālas beigas

Kad skriesit SplitIntoSheets () procedūru, lapa tiks sadalīta vairākās lapās, pamatojoties uz doto kolonnu. Lapai varat pievienot pogu un piešķirt tai šo makro.

Kā tas strādā
Iepriekš minētajam kodam ir divas procedūras un viena funkcija. Ir divas procedūras SplitIntoSheets (), CreateSheets (unikāls kā diapazons, clmNo tik ilgi) un viena funkcija ir RemoveDuplicates (unikāls kā diapazons) kā diapazons.

Pirmā procedūra ir SplitIntoSheets (). Šī ir galvenā procedūra. Šī procedūra nosaka mainīgos un RemoveDuplicates lai iegūtu unikālus nosaukumus no dotās kolonnas un pēc tam nodotu šos nosaukumus CreateSheets lapu izveidošanai.

RemoveDuplicates ņem vienu argumentu, kas ir diapazons, kurā ir nosaukums. Noņem dublikātus no tiem un atgriež diapazona objektu, kurā ir unikāli nosaukumi.

Tagad CreateSheets tiek saukts. Tam nepieciešami divi argumenti. Pirmkārt, unikālie nosaukumi un, otrkārt, sleja Nr. no kura mēs to apkoposim. Tagad CreateSheets ņem katru nosaukumu no unikālajiem un filtrē doto slejas numuru pēc katra nosaukuma. Kopē filtrētos datus, pievieno lapu un ielīmē datus tur. Un jūsu dati tiek sadalīti dažādās lapās dažu sekunžu laikā.

Jūs varat lejupielādēt failu šeit.
Sadalīt lapās

Kā izmantot failu:

- Kopējiet savus datus 1. lapā. Pārliecinieties, ka tas sākas no A1.

- Noklikšķiniet uz pogas Sadalīt lapās
- Ievadiet kolonnas burtu, no kura vēlaties sadalīt. Noklikšķiniet uz Labi.

- Jūs redzēsit šādu uzvedni. Jūsu lapa ir sadalīta.

Es ceru, ka raksts par datu sadalīšanu atsevišķās lapās jums bija noderīgs. Ja jums ir šaubas par šo vai kādu citu Excel funkciju, nekautrējieties to jautāt komentāru sadaļā zemāk.