Excel Sayfasını VBA Kullanarak Sütuna Dayalı Birden Çok Dosyaya Böl

Excel sayfasında büyük bir veriye sahip misiniz ve bu sayfayı bir sütundaki bazı verilere dayanarak birden çok sayfaya mı dağıtmanız gerekiyor? Bu çok temel bir görev ama zaman alıcı.

Örneğin, bu verilere sahibim. Bu veri adlı bir sütun var Tarih, Yazar ve Başlık. Yazar sütununda ilgili başlığın yazarının adı bulunur. Her yazarın verilerini ayrı sayfalarda almak istiyorum.

Bunu manuel olarak yapmak için aşağıdakileri yapmam gerekiyor:

Bir adı filtrele
Filtrelenmiş verileri kopyalayın
Sayfa ekle
Verileri yapıştırın
Sayfayı yeniden adlandır
Her biri için yukarıdaki 5 adımı tekrarlayın.

Bu örnekte sadece üç ismim var. 100'lerce isim olduğunu hayal edin. Verileri farklı sayfalara nasıl bölersiniz? Çok zaman alacak ve sizi de tüketecek.
Yukarıdaki sayfayı birden çok sayfaya bölme işlemini otomatikleştirmek için aşağıdaki adımları izleyin.

Alt+F11 tuşlarına basın. Bu, Excel için VB Düzenleyiciyi açacaktır.
Yeni Modül Ekle
Modülde Aşağıdaki Kodu Kopyalayın.

 Alt SplitIntoSheets() Uygulama ile .ScreenUpdating = False .DisplayAlerts = ThisWorkbook ile Yanlış Son. Sayfa1'i Etkinleştir. Varsa 'filtreyi temizliyor Hatada Sonraki Sayfayı Sürdür1.Hatada Tüm Verileri Göster 0'a Git 0 Dim lsrClm Uzun Dim lstRow As Long 'son kullanılan satırı sayma Hücre lstRow = (Rows.Count, 1).End(xlUp).Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo işleyicisi clm = Application.InputBox("Dosyaları oluşturmak istediğiniz sütundan" & vbCrLf & "Örn. A,B,C,AB,ZA vb.") clmNo = Aralık(clm & "1").Column Set uniques = Range(clm & "2:" & clm & lstRow) 'Çağrı Eşsiz Ad Kümesi Almak için Yinelenenleri Kaldır uniques = RemoveDuplicates(uniques) Uygulama ile CreateSheets(uniques, clmNo) Çağır .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculation Sheet1 ile Otomatik Sonlandır. MsgBox'ı Etkinleştir "Aferin!" Exit Sub Data.ShowAllData işleyicisi: Uygulama ile .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationOtomatik End With End Sub İşlev RemoveDuplicates(Uniques As Range) As Range ThisWorkbook.Activate Sheets.Add On Hata Devam Et Sonraki ActiveSheet.Name = "uniques" Sheets("uniques").Hatada Etkinleştir 0 Uniques'e Git.Copy Cells(2, 1).Activate ActiveCell.PasteSpecial xlPasteValues Range("A1") .Value = "uniques" Dim lstRow As Long lstRow = Cells(Rows.Count, 1).End(xlUp).Row Range("A2:A" & lstRow).Select ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns :=1, Header:=xlNo lstRow = Cells(Rows.Count, 1).End(xlUp).Row Set RemoveDuplicates = Range("A2:A" & lstRow) End Function Sub CreateSheets(Uniques As Range, clmNo As Long) Dim lstClm Uzun Dim lstRow Her benzersiz benzersiz için Sheet1.Activate lstRow = Cells(Rows.Count, 1).End(xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Dim dataSet As Range Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.AutoFilter field:=clmNo, Criteria1:=unique.Value lstRow = Cells(Rows.Count, 1).End( xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Debug.Print lstRow; lstClm Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Sonraki benzersiz End Sub

ne zaman koşacaksın Sayfaları Böl() prosedür, sayfa verilen sütuna göre birden çok sayfaya bölünecektir. Sayfaya buton ekleyebilir ve bu makroyu ona atayabilirsiniz.

Nasıl çalışır
Yukarıdaki kodun iki prosedürü ve bir işlevi vardır. İki prosedür SplitIntoSheets(), CreateSheets(uniques As Range, clmNo As Long) ve bir fonksiyon RemoveDuplicates(Uniques As Range) As Range.

İlk Prosedür Sayfaları Böl(). Bu ana prosedürdür. Bu prosedür değişkenleri ayarlar ve Yinelenenleri Kaldır verilen sütundan benzersiz adlar almak ve ardından bu adları Sayfa Oluştur sayfalar oluşturmak için.

Yinelenenleri Kaldır adı içeren aralık olan bir bağımsız değişken alır. Yinelenenleri kaldırır onlardan ve benzersiz adlar içeren bir aralık nesnesi döndürür.

Şimdi Sayfa Oluştur denir. İki argüman alır. İlk önce benzersiz adlar ve ikinci sütun no. verileri filtreleyeceğiz. Şimdi Sayfa Oluştur benzersizlerden her adı alır ve verilen sütun numarasını her ada göre filtreler. Filtrelenen verileri kopyalar, bir sayfa ekler ve verileri buraya yapıştırır. Ve verileriniz saniyeler içinde farklı sayfalara bölünür.

Dosyayı buradan indirebilirsiniz.
Sayfalara Böl

Dosya nasıl kullanılır:

- Verilerinizi Sayfa1'e kopyalayın. A1'den başladığından emin olun.

- Sayfalara Böl Düğmesine tıklayın
- Bölmek istediğiniz sütun harfini girin. Tamam'ı tıklayın.

- Bunun gibi bir istem göreceksiniz. Sayfanız bölündü.

Umarım verileri ayrı sayfalara bölmeyle ilgili makale sizin için yararlı olmuştur. Bu veya excel'in başka bir özelliği hakkında herhangi bir şüpheniz varsa, bunu aşağıdaki yorumlar bölümünde sormaktan çekinmeyin.