Şimdi Ara

Excel satırları belli sayılarda bölme

Bu Konudaki Kullanıcılar:
2 Misafir - 2 Masaüstü
5 sn
32
Cevap
0
Favori
6.342
Tıklama
Daha Fazla
İstatistik
  • Konu İstatistikleri Yükleniyor
0 oy
Öne Çıkar
Sayfa: 12
Sayfaya Git
Git
sonraki
Giriş
Mesaj
  • Herkese merhabalar, elimde içerisinde 40,000 satır veri bulunan bir excel dosyası var ve benim bu 40,000 satırı 100 100 partlara bölmem gerekiyor, bunu nasıl yapabileceğim konusunda yardım edebilecek olan varsa çok mutlu olurum, şimdiden teşekkürler.



  • Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.

    makroyu kullanmak için
    excel dosyan açıkken;
    excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle
    kod alanına aşağıdaki kodları ekle
    çalıştırmak için F5 e bas
    ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır

    Sub SatirlariSayfalaraAktar() 
    'makro: Mesut Akcan
    '15 Eylül 2018
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
    satirlar = Str(n) & ":" & Trim(Str(n + 99))
    Rows(satirlar).EntireRow.Copy

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

    DoEvents

    'Sheets(1).Activate
    Next
    Sheets(1).Activate
    End Sub
    Kodları biraz geliştirdim.
    Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuz

    Sub SatirlariDosyalaraAktar()
    'makro: Mesut Akcan
    '29 Temmuz 2019
    Dim SatirSayisi As Long
    Dim Dn As Integer, n As Integer
    Dim Klasor As String, satirlar As String, Dosya As String

    SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
    If SatirSayisi < 1 Then Exit Sub
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Format(Dn, "000")
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamam!"
    End Sub



    Kodda
    If SatirSayisi <span><</span> 1 Then Exit Sub
    satırı forum tarafından otomatik değiştiriliyor.
    Orjinali şu:
    If SatirSayisi < 1 Then Exit Sub

    ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html
  • part derken ayrı sayfalara mı ayrı dosyalara mı?
  • quote:

    Orijinalden alıntı: akcan

    part derken ayrı sayfalara mı ayrı dosyalara mı?
    Ayrı sheet'e de olur dosyaya da olur hiç fark etmez sadece 100'lü paketlere bölmem gerekiyor
  • Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.

    makroyu kullanmak için
    excel dosyan açıkken;
    excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle
    kod alanına aşağıdaki kodları ekle
    çalıştırmak için F5 e bas
    ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır

    Sub SatirlariSayfalaraAktar() 
    'makro: Mesut Akcan
    '15 Eylül 2018
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
    satirlar = Str(n) & ":" & Trim(Str(n + 99))
    Rows(satirlar).EntireRow.Copy

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

    DoEvents

    'Sheets(1).Activate
    Next
    Sheets(1).Activate
    End Sub
  • quote:

    Orijinalden alıntı: akcan

    Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.

    makroyu kullanmak için
    excel dosyan açıkken;
    excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle
    kod alanına aşağıdaki kodları ekle
    çalıştırmak için F5 e bas
    ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır

    Sub SatirlariSayfalaraAktar() 
    'makro: Mesut Akcan
    '15 Eylül 2018
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
    satirlar = Str(n) & ":" & Trim(Str(n + 99))
    Rows(satirlar).EntireRow.Copy

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

    DoEvents

    'Sheets(1).Activate
    Next
    Sheets(1).Activate
    End Sub
    Hocam çok sağol denedim oldu şimdi ama bu 100lü paketleri farklı excel dosyası olarak kaydedemeyiz değil mi ?



    < Bu mesaj bu kişi tarafından değiştirildi batuhantstkn -- 16 Eylül 2018; 9:7:23 >
  • önceki mesajımda sormuştum sayfalara mı dosyalara mı diye, farketmez deyince sayfalara veren kod yazmıştım.
    neyse dosyalara bölen kodu da yazdım. her iki koda da ihtiyacı olan olabilir.

    Sub SatirlariDosyalaraAktar() 
    'makro: Mesut Akcan
    '16 Eylül 2018
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 99))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Trim(Dn)
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamama"
    End Sub
  • quote:

    Orijinalden alıntı: akcan

    önceki mesajımda sormuştum sayfalara mı dosyalara mı diye, farketmez deyince sayfalara veren kod yazmıştım.
    neyse dosyalara bölen kodu da yazdım. her iki koda da ihtiyacı olan olabilir.

    Sub SatirlariDosyalaraAktar() 
    'makro: Mesut Akcan
    '16 Eylül 2018
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 99))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Trim(Dn)
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamama"
    End Sub
    hocam cidden çok sağol illa benim haricimde de çok kişinin işine yarayacaktır, bu arada imacros üzerinde macro yazabiliyor musun ?
  • imacros'u ilk defa duydum.
  • quote:

    Orijinalden alıntı: akcan

    imacros'u ilk defa duydum.
    Auto clicker için bir eklenti ama hallettim teşekkür ederim :)
  • quote:

    Orijinalden alıntı: akcan

    imacros'u ilk defa duydum.
    hocam çıktıları .csv olarak kaydetmenin imkanı var mı ?
  • ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    satırının sonuna
    , FileFormat:=xlCSV
    ekleyin.

    yani
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya, FileFormat:=xlCSV



    < Bu mesaj bu kişi tarafından değiştirildi akcan -- 12 Ekim 2018; 7:15:9 >
  • Benim de bu duruma benzer bir ihtiyacım var ben her satırın ayrı ayrı dosyalara bölünmesini istiyorum yani sadece a satırını içeren bir dosya bu örnek galiba 100'er 100'er bölüyor ben makroda 100 olan kısmı bir yaptım ancak bu sefer bir üstündeki satırı silerek ayrı dosya oluşturdu yardım ederseniz çok sevinirim umarım kendimi ifade etmişimdir.
  • Kodları biraz geliştirdim.
    Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuz

    Sub SatirlariDosyalaraAktar()
    'makro: Mesut Akcan
    '29 Temmuz 2019
    Dim SatirSayisi As Long
    Dim Dn As Integer, n As Integer
    Dim Klasor As String, satirlar As String, Dosya As String

    SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
    If SatirSayisi < 1 Then Exit Sub
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Format(Dn, "000")
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamam!"
    End Sub



    Kodda
    If SatirSayisi <span><</span> 1 Then Exit Sub
    satırı forum tarafından otomatik değiştiriliyor.
    Orjinali şu:
    If SatirSayisi < 1 Then Exit Sub

    ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html



    < Bu mesaj bu kişi tarafından değiştirildi akcan -- 26 Haziran 2023; 12:47:11 >
  • quote:

    Orijinalden alıntı: akcan

    Kodları biraz geliştirdim.
    Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuz

    Sub SatirlariDosyalaraAktar()
    'makro: Mesut Akcan
    '29 Temmuz 2019
    Dim SatirSayisi As Long
    Dim Dn As Integer, n As Integer
    Dim Klasor As String, satirlar As String, Dosya As String

    SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
    If SatirSayisi < 1 Then Exit Sub
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Format(Dn, "000")
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamam!"
    End Sub



    Kodda
    If SatirSayisi <span><</span> 1 Then Exit Sub
    satırı forum tarafından otomatik değiştiriliyor.
    Orjinali şu:
    If SatirSayisi < 1 Then Exit Sub

    ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html
    elinize sağlık çok işime yaradı ancak son bir talebim olacak eğer yapma imkanınız varsa; toplam 2000 satır var ben 250'şerli olarak ayırmak istiyorum ama bu 250'lik kısımları .txt olarak kaydetmesini istiyorum.
  • kodlarda isteğinize uygun değişiklikleri yaptım.
    satır sayısını kod çalışınca size soracak zaten 250 de girebilirsin 100 de.

    Sub SatirlariDosyalaraAktar3()
    'makro: Mesut Akcan
    '25 Eylül 2019
    'txt olarak kaydeder
    Dim SatirSayisi As Long
    Dim dosyaNo As Integer, n As Integer
    Dim klasor As String, satirlar As String, dosyaAdi As String
    Dim yeniDosya As Workbook

    SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
    If SatirSayisi < 1 Then Exit Sub
    klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
    Rows(satirlar).EntireRow.Copy
    dosyaNo = dosyaNo + 1
    dosyaAdi = "Dosya_" & Format(dosyaNo, "000")
    Set yeniDosya = Workbooks.Add
    With yeniDosya
    .Sheets(1).Paste
    .SaveAs Filename:=klasor & dosyaAdi, FileFormat:=xlText
    .Close
    End With
    DoEvents
    Next
    MsgBox "İşlem Tamam!"
    End Sub


    Koddaki
    If SatirSayisi <span><</span> 1 Then Exit Sub
    satırı forum tarafından otomatik değiştiriliyor nedense.
    Orjinali şu:
    If SatirSayisi < 1 Then Exit Sub



    < Bu mesaj bu kişi tarafından değiştirildi akcan -- 25 Eylül 2019; 15:32:56 >
  • quote:

    Orijinalden alıntı: akcan

    kodlarda isteğinize uygun değişiklikleri yaptım.
    satır sayısını kod çalışınca size soracak zaten 250 de girebilirsin 100 de.

    Sub SatirlariDosyalaraAktar3()
    'makro: Mesut Akcan
    '25 Eylül 2019
    'txt olarak kaydeder
    Dim SatirSayisi As Long
    Dim dosyaNo As Integer, n As Integer
    Dim klasor As String, satirlar As String, dosyaAdi As String
    Dim yeniDosya As Workbook

    SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
    If SatirSayisi < 1 Then Exit Sub
    klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
    Rows(satirlar).EntireRow.Copy
    dosyaNo = dosyaNo + 1
    dosyaAdi = "Dosya_" & Format(dosyaNo, "000")
    Set yeniDosya = Workbooks.Add
    With yeniDosya
    .Sheets(1).Paste
    .SaveAs Filename:=klasor & dosyaAdi, FileFormat:=xlText
    .Close
    End With
    DoEvents
    Next
    MsgBox "İşlem Tamam!"
    End Sub


    Koddaki
    If SatirSayisi <span><</span> 1 Then Exit Sub
    satırı forum tarafından otomatik değiştiriliyor nedense.
    Orjinali şu:
    If SatirSayisi < 1 Then Exit Sub
    çok sağolun. elleriniz dert görmesin.
  • twitter üzerinden sorulan bir soru:
    Mesut hocam selamlar, bir konuda yardımınıza ihtiyacım var, bir tane excel makronuza ulaştım satırları dosyalara aktar başlığında, çok verili exceli 999 999 dosyalar oluşturduğunuz, benim işime 750 750 lazım kodda ufak değişiklik yapınca oldu zaten, bu benim işimi çok fazlasıyla gördü ama bir ufak daha yardımınız olursa süper olur, ana excelimdeki ilk satırı (yani başlığı) bütün parça parça excellerin ilk satırı olmasını istiyorum, araştırdım ama işin içinden çıkamadı makroya böyle bir kod yazmak mümkün mü yardımlarınızı rica ederim. bir sonraki mesajımda makronuzu göndereceğim.
    Sub SatirlariDosyalaraAktar()
    'makro: Mesut Akcan
    '16 Eylül 2018
    Klasor = ActiveWorkbook.Path & "\"
    For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 750
    satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 749))
    Rows(satirlar).EntireRow.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Dn = Dn + 1
    Dosya = "Dosya_" & Trim(Dn)
    ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
    ActiveWorkbook.Close
    DoEvents
    Next
    MsgBox "İşlem Tamama"
    End Sub

    Ana excelim yaklaşık 200000 veri var totalde 265 dosya yapıyor tek tek kopyala yapıştır yapmaktan daha kısa bir yol varsa yardımınızı rica ederim.
  • akcan kullanıcısına yanıt

    Mesut bey merhaba, yazdığınız kodu belirli sayılara göre değil de sütunlar içinde yer alan belirli isimlere göre ayırabilir miyiz? Örneğin, elimdeki veri listesinde X ve Y sütunlarında veri noktaları yer almakta ve her bir serinin başında X ve b

    Excel satırları belli sayılarda bölme

    ir isim yer almakta. Her dizinin başında bulunan X satırından bir sonraki X satırına kadar olan kısımları ayrı ayrı kaydedebilir miyiz?

  • 
Sayfa: 12
Sayfaya Git
Git
sonraki
- x
Bildirim
mesajınız kopyalandı (ctrl+v) yapıştırmak istediğiniz yere yapıştırabilirsiniz.