Jagage Exceli leht mitmeks failiks, kasutades veergu, kasutades VBA -d

Anonim

Kas teil on Exceli lehel suured andmed ja peate selle lehe jaotama mitmele lehele, tuginedes mõnele veeru andmetele? See on väga lihtne ülesanne, kuid aeganõudev.

Näiteks on mul need andmed. Nendel andmetel on veerg nimega Kuupäev, kirjanik ja Pealkiri. Kirjanikuveerul on vastava pealkirjaga kirjaniku nimi. Soovin saada iga kirjaniku andmed eraldi lehtedena.

Selle käsitsi tegemiseks pean tegema järgmist.

  1. Filtreerige üks nimi
  2. Kopeerige filtreeritud andmed
  3. Lisage leht
  4. Kleepige andmed
  5. Nimeta leht ümber
  6. Korrake kõiki ülaltoodud 5 sammu.

Selles näites on mul ainult kolm nime. Kujutage ette, kui teil on 100 nime. Kuidas jagada andmed erinevateks lehtedeks? See võtab palju aega ja tühjendab ka teid.
Ülaltoodud lehe mitmeks leheks jagamise protsessi automatiseerimiseks toimige järgmiselt.

  • Vajutage klahve Alt+F11. See avab Exceli jaoks VB redaktori
  • Lisage uus moodul
  • Kopeerige moodulis kood alla.
 Sub SplitIntoSheets () Rakendusega .ScreenUpdating = False .DisplayAlerts = Vale lõpp käesoleva töövihikuga. Aktiveerige leht 1. Aktiveerige tühjendusfilter, kui see on olemas. Jätka järgmisel lehel (Rows.Count, 1) .End (xlUp) .Rida Dim unikaalne As Range Dim clm Stringina, clmNo As Long On Error GoTo handler clm = Application.InputBox ("Millisest veerust soovite faile luua" & vbCrLf & "Nt "A" uniques = RemoveDuplicates (unikaalsed) Helista CreateSheets (unikaalsed, clmNo) Rakendusega .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Hästi tehtud!" Väljuge alamandmetest. ShowAllData käitleja: koos rakendusega .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Funktsioon RemoveDuplicates (unikaalne kui vahemik) kui vahemik ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets ("uniques"). Activate On Error GoTo 0 uniques.Copy Cells (2, 1) .Activate ActiveCell.PasteSpecial xlPasteValues ​​Range ("A1") .Value = "uniques" Dim lstRow As Long lstRow = Lahtrid (Rows.Count, 1) .End (xlUp) .Row Range ("A2: A" & lstRow). Valige ActiveSheet.Range (Selection.Address) .RemoveDuplicates Columns : = 1, päis: = xlNo lstRow = Lahtrid (Rows.Count, 1) .End (xlUp) .Rida Määra RemoveDuplicates = Vahemik ("A2: A" & lstRow) Lõppfunktsioon Sub CreateSheets (ainulaadne kui vahemik, clmNo nii kaua) Dim lstClm nii pikk Dim lstRow sama kaua iga kordumatu ainulaadne leht 1. Aktiveerige lstRow = Lahtrid (Rows.Count, 1). End (xlUp) .Row lstClm = Lahtrid (1, Columns.Count) .End (xlToLeft) .Veerg Dim dataSet kui vahemik Set dataSet = Range (Cells (1, 1), Cells (lstRow, lstClm)) dataSet.AutoFilter field: = clmNo, Criteria1: = unique.Value lstRow = Lahtrid (Rows.Count, 1) .End ( xlUp). Rida lstClm = Lahtrid (1, Veerud. Loend). Lõpp (xlToLeft). Veeru silumine. Prindi lstRow; lstClm Set dataSet = Vahemik (lahtrid (1, 1), lahtrid (lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next kordumatu lõpp

Kui jooksed SplitIntoSheets () protseduuri korral jagatakse leht antud veeru põhjal mitmeks leheks. Saate lisada lehele nupu ja määrata sellele makro.

Kuidas see töötab
Ülaltoodud koodil on kaks protseduuri ja üks funktsioon. Kaks protseduuri on SplitIntoSheets (), CreateSheets (ainulaadne vahemik, clmNo nii kaua) ja üks funktsioon on RemoveDuplicates (unikaalne kui vahemik) kui vahemik.

Esimene protseduur on SplitIntoSheets (). See on peamine protseduur. See protseduur määrab muutujad ja RemoveDuplicates , et saada antud veerust unikaalseid nimesid ja seejärel need nimed edastada Loo lehed lehtede loomiseks.

RemoveDuplicates võtab ühe argumendi, mis on nime sisaldav vahemik. Eemaldab duplikaadid ja tagastab vahemiku objekti, mis sisaldab unikaalseid nimesid.

Nüüd Loo lehed kutsutakse. See nõuab kahte argumenti. Esiteks unikaalsed nimed ja teiseks veerg nr. kust me andmeid kogume. Nüüd Loo lehed võtab iga nime unikaalsetest ja filtreerib antud veeru numbri iga nime järgi. Kopeerib filtreeritud andmed, lisab lehe ja kleepib andmed sinna. Ja teie andmed jagatakse mõneks sekundiks erinevatele lehtedele.

Faili saate alla laadida siit.
Jaotage lehtedeks

Kuidas faili kasutada:

    • Kopeerige oma andmed lehele 1. Veenduge, et see algab A1 -st.

    • Klõpsake nupule Arvutustabeliteks jagamine
    • Sisestage veeru täht, millest soovite eraldada. Klõpsake nuppu OK.

    • Näete sellist viipa. Teie leht on poolitatud.



Loodan, et artikkel andmete eraldamiseks eraldi lehtedeks oli teile kasulik. Kui teil on selle või mõne muu Exceli funktsiooni osas kahtlusi, küsige seda allpool kommentaaride osas.

Faili allalaadimine:

Jagage Exceli leht mitmeks failiks, kasutades veergu, kasutades VBA -d