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

Aşağı Git Tüm Forumlar İşletim Sistemleri ve Yazılımlar Yazılım Genel Ofis Uygulamaları Excel satırları belli sayılarda bölme

Bu konudaki kullanıcılar: 1 misafir

28
Cevap 8148
Tıklama 0
Öne Çıkarma

Son Sonraki

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

Cevap Yaz

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

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.

En Çok Beğenilenler Tümü Saat Gün Hafta Ay Yıl ✔ Tümü Tüm Yorumları Aç

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...

Yoruma Git Yorumun Devamı akcan - 8 yıl +2 ▲

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

Yoruma Git Yorumun Devamı akcan - 7 yıl +2 ▲

akcan

8 yıl (2164 mesaj)

Binbaşı

part derken ayrı sayfalara mı ayrı dosyalara mı?

Bu mesaja 1 cevap geldi.

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

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

akcan

8 yıl (2164 mesaj)

Binbaşı

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

Bu mesaja 2 cevap geldi.

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

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 >

akcan

8 yıl (2164 mesaj)

Binbaşı

ö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

Bu mesaja 1 cevap geldi.

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

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 ?

akcan

8 yıl (2164 mesaj)

Binbaşı

imacros'u ilk defa duydum.

Bu mesaja 2 cevap geldi.

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

quote:

Orijinalden alıntı: akcan

imacros'u ilk defa duydum.

Auto clicker için bir eklenti ama hallettim teşekkür ederim :)

batuhantstkn

8 yıl (471 mesaj)

Yüzbaşı

Konu Sahibi

quote:

Orijinalden alıntı: akcan

imacros'u ilk defa duydum.

hocam çıktıları .csv olarak kaydetmenin imkanı var mı ?

akcan

8 yıl (2164 mesaj)

Binbaşı

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 >

irfan_1987

7 yıl (8 mesaj)

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.

akcan

7 yıl (2164 mesaj)

Binbaşı

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 < 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 >
Bu mesaja 2 cevap geldi.

findiknet

7 yıl (23 mesaj)

Onbaşı

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 < 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.

akcan

7 yıl (2164 mesaj)

Binbaşı

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 < 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 >
Bu mesaja 1 cevap geldi.

findiknet

7 yıl (23 mesaj)

Onbaşı

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 < 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.

akcan

6 yıl (2164 mesaj)

Binbaşı

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.

Bu mesaja 1 cevap geldi.

ferhan.ozturk

5 yıl (1 mesaj)

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
< Resime gitmek için tıklayın >
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?

Bu mesaja 1 cevap geldi.

Bu mesajda bahsedilenler: @akcan

Son Sonraki