Arama butonu
Bu konudaki kullanıcılar: 1 misafir
28
Cevap
8150
Tıklama
0
Öne Çıkarma
Excel satırları belli sayılarda bölme
B
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.

DH forumlarında vakit geçirmekten keyif alıyor gibisin ancak giriş yapmadığını görüyoruz.

Üye olduğunda özel mesaj gönderebilir, beğendiğin konuları favorilerine ekleyip takibe alabilir ve daha önce gezdiğin konulara hızlıca erişebilirsin.

Üye Ol Şimdi Değil



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

S
                                
Yoruma Git
Yorumun Devamı akcan - 7 yıl +2
A
8 yıl (2164 mesaj)
Binbaşı

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


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



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

A
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.
B
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 ?



A
8 yıl (2164 mesaj)
Binbaşı

B
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 :)



B
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ı ?



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

İ
7 yıl (8 mesaj)
Er

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.



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



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



A
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.
F
5 yıl (1 mesaj)
Er

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