Jaa Excel -taulukko useisiin tiedostoihin sarakkeen perusteella käyttämällä VBA: ta

Onko sinulla Excel -taulukossa suuria tietoja ja sinun on jaettava kyseinen taulukko useille arkeille joidenkin sarakkeen tietojen perusteella? Tämä on hyvin yksinkertainen tehtävä, mutta aikaa vievä.

Esimerkiksi minulla on nämä tiedot. Näissä tiedoissa on sarake nimeltä Päivämäärä, kirjoittaja ja Otsikko. Kirjoittaja -sarakkeessa on vastaavan otsikon kirjoittajan nimi. Haluan saada jokaisen kirjoittajan tiedot erillisiksi arkkeiksi.

Jos haluat tehdä tämän manuaalisesti, minun on tehtävä seuraava:

Suodata yksi nimi
Kopioi suodatetut tiedot
Lisää arkki
Liitä tiedot
Nimeä arkki uudelleen
Toista kaikki edellä mainitut viisi vaihetta.

Tässä esimerkissä minulla on vain kolme nimeä. Kuvittele, jos sinulla on 100 nimeä. Miten jakaisit tiedot eri arkeiksi? Se vie paljon aikaa ja tyhjentää myös sinut.
Voit automatisoida arkin jakamisen useiksi arkkeiksi seuraavasti:

Paina Alt+F11. Tämä avaa VB Editor for Excel
Lisää uusi moduuli
Kopioi koodin alapuolella moduulissa.

 AlajakoIntoSheets () Sovelluksella .ScreenUpdating = False .DisplayAlerts = False End With thisWorkbook.Activate Sheet1.Activate 'clearing filter ifAn On Error Jatka seuraavaa taulukkoa1.ShowAllData On Error GoTo 0 Dim lsrClm Niin pitkä Dim lstRow Niin kauan' lasketaan viimeksi käytetty rivi lstRow = Solut (Rows.Count, 1) .End (xlUp) .Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo handler clm = Application.InputBox ("Mistä sarakkeesta haluat luoda tiedostoja" & vbCrLf & "Esim. " uniques = RemoveDuplicates (uniques) Soita CreateSheets (uniques, clmNo) Sovelluksella .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Hyvin tehty!" Exit Sub Data.ShowAllData -käsittelijä: Sovelluksen kanssa .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Toiminto RemoveDuplicates (ainutlaatuinen alueena) As Range ThisWorkbook.Activate Sheets.Add On Error Jatka Seuraava 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 = Solut (Rows.Count, 1) .End (xlUp) .Row Range ("A2: A" & lstRow) .Valitse ActiveSheet.Range (Selection.Address) .RemoveDuplicates Columns : = 1, Otsikko: = xlNo lstRow = Solut (Rows.Count, 1) .End (xlUp) .Row Set RemoveDuplicates = Range ("A2: A" & lstRow) End Function Sub CreateSheets (uniikki As Range, clmNo As Long) Dim lstClm niin kauan Dim lstRow niin kauan jokaiselle ainutlaatuiselle ainutlaatuiselle taulukolle 1.Aktivoi lstRow = Solut (Rows.Count, 1) .End (xlUp) .Row lstClm = Solut (1, Columns.Count) .End (xlToLeft). Dim dataSet As Range Set dataSet = Range (Solut (1, 1), Solut (lstRow, lstClm)) dataSet.AutoFilter -kenttä: = clmNo, Criteria1: = unique.Value lstRow = Solut (Rows.Count, 1) .End ( xlUp) .Row lstClm = Solut (1, Columns.Count) .End (xlToLeft) .Column Debug.Print lstRow; lstClm Set dataSet = Range (Solut (1, 1), Solut (lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next unique End Sub

Kun juokset SplitIntoSheets () menettely, taulukko jaetaan useisiin arkkeihin annetun sarakkeen perusteella. Voit lisätä arkin painikkeen ja määrittää tämän makron sille.

Kuinka se toimii
Yllä olevassa koodissa on kaksi toimintoa ja yksi toiminto. Kaksi menettelyä on SplitIntoSheets (), CreateSheets (uniques As Range, clmNo As Long) ja yksi toiminto on RemoveDuplicates (ainutlaatuinen alue) As Range.

Ensimmäinen menettely on SplitIntoSheets (). Tämä on päämenettely. Tämä menettely asettaa muuttujat ja RemoveDuplicates saada yksilöllisiä nimiä annetusta sarakkeesta ja välittää ne sitten CreateSheets arkkien luomiseen.

RemoveDuplicates ottaa yhden argumentin, joka on alue, joka sisältää nimen. Poistaa kaksoiskappaleet ja palauttaa alueobjektin, joka sisältää yksilöllisiä nimiä.

Nyt CreateSheets kutsutaan. Se vaatii kaksi argumenttia. Ensin yksilölliset nimet ja toiseksi sarake nro. josta saamme tietoja. Nyt CreateSheets ottaa jokaisen nimen yksilöllisyydestä ja suodattaa annetun sarakkeen numeron kunkin nimen mukaan. Kopioi suodatetut tiedot, lisää taulukon ja liittää tiedot sinne. Ja tietosi jaetaan eri arkkeihin muutamassa sekunnissa.

Voit ladata tiedoston täältä.
Jaa arkeiksi

Tiedoston käyttö:

- Kopioi tiedot Sheet1: lle. Varmista, että se alkaa A1: stä.

- Napsauta painiketta Jaa arkeiksi
- Syötä sarakkeen kirjain, josta haluat jakaa. Napsauta OK.

- Näet tällaisen kehotteen. Arkki on halkaistu.

Toivon, että artikkeli tietojen jakamisesta erillisiin arkkeihin oli sinulle hyödyllinen. Jos sinulla on epäilyksiä tästä tai muista Excelin ominaisuuksista, voit kysyä sitä alla olevasta kommenttiosasta.