تکه تکه کردن یک فایل حجیم اکسل

[ahmad19]

سلام
من یه فایل دارم که حدود 1 میلیون سطر داره
اما برای پروژه ای که دارم باید خروجی ها بیش تر از 10 هزار سطر نشه
چطور می شه به اکسل فهموند که ابن 1 میلیون سطر ما رو بکنه 10 هزار تا 10 هزار نا و با فرمت 2003 خروجی بده
تو فروم های خارجی گشتم پیدا نکردم گفتم شاید مهندسین داخلی بتونن کمکم کنن
ممنون می شم کسی راهی به ذهنش می رسه بگه

[iranweld]

با سلام

در فایل پیوست هر 10000 سطر هم بصورت یک شیت در این فایل و هم بصورت یک فایل مجزا در مسیر فایل جاری ایجاد میگردد(دیتای خود را در شیت اول این فایل پیست کنید یا ماکرو ذیل را در فایل خود اضافه کنید)


Sub Macro1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To 100
Rows("1:10000").Cut
Sheets.Add After:=Sheets(Sheets.Count)
Rows("1:1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Sheet1").Select

ActiveSheet.Buttons.Add(241.5, 93, 96, 38.25).Select
Selection.OnAction = "Macro1"

Next

Sheet_SaveAs



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Sub Sheet_SaveAs()

Dim wb As Workbook

For Each Sheet In Worksheets

xx = Sheet.Name

If Sheet.Name <> "Sheet1" Then

Sheet.Copy

Set wb = ActiveWorkbook

With wb

.SaveAs ThisWorkbook.Path & "\" & xx & ".xlsx"

.Close

End With

End If

Next

End Sub

[ahmad19]

با تشکر از شما برای راهنمایی اما این فایل چون خودش 2003 هست بیش تر از 65000 سطر قبول نمی کنه
نکته بعدی اینکه آیا امکانش هست سطر اول رو برای همه فایل ها بذاره یعنی سطر اول تو همش ثابت باشه از سطر 2 به بعد 10000 تا رو بخونه فایل جدید رو بسازه
خیلی ممنون مهندس

[ahmad19]

با سلام

در فایل پیوست هر 10000 سطر هم بصورت یک شیت در این فایل و هم بصورت یک فایل مجزا در مسیر فایل جاری ایجاد میگردد(دیتای خود را در شیت اول این فایل پیست کنید یا ماکرو ذیل را در فایل خود اضافه کنید)


Sub Macro1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To 100
Rows("1:10000").Cut
Sheets.Add After:=Sheets(Sheets.Count)
Rows("1:1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Sheet1").Select

ActiveSheet.Buttons.Add(241.5, 93, 96, 38.25).Select
Selection.OnAction = "Macro1"

Next

Sheet_SaveAs



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Sub Sheet_SaveAs()

Dim wb As Workbook

For Each Sheet In Worksheets

xx = Sheet.Name

If Sheet.Name <> "Sheet1" Then

Sheet.Copy

Set wb = ActiveWorkbook

With wb

.SaveAs ThisWorkbook.Path & "\" & xx & ".xlsx"

.Close

End With

End If

Next

End Sub


مهندس فایل رو درست کردم اما شیت ها رو ساخت اما فقط 10 هزارتای اول رو برداشت تو شیت 2 ذخیره کرد و اون شیت ها رو پاک نکرد و باقی شیت ها رو خالی درست کرد
امکانش هست فایل رو براتون بفرستم تست کنید؟

[iranweld]

با سلام

مشکل ماکرو قبلی برطرف شد


Sub Macro1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

z1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlDown).Row
xx = Int(z1 / 10000) + 1

On Error Resume Next
x = 2

For i = 1 To xx

Sheets.Add After:=Sheets(Sheets.Count)

Sheets("Xaaaa").Rows("1:1").Copy

Rows("1:1").Select

ActiveSheet.Paste

Sheets("Xaaaa").Rows(x & ":" & x + 9999).Copy

Rows("2:2").Select

ActiveSheet.Paste

x = x + 10000

Next



Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[maskpm]

درود به همگی
ببخشید این تاپیک رو بالا میارم
منم یه فایل دارم که 700 تا خط هست
دقیقا میخوام به پارت های 50 یا 40 تایی تقسیم کنم و پارت پارت ایجاد بشه
ممنون میشم کمک کنید

[Amir Ghasemiyan]

درود به همگی
ببخشید این تاپیک رو بالا میارم
منم یه فایل دارم که 700 تا خط هست
دقیقا میخوام به پارت های 50 یا 40 تایی تقسیم کنم و پارت پارت ایجاد بشه
ممنون میشم کمک کنید

سلام دوست عزيز
كافيه هر جا 1000 ديديد تبديل به 50 كنيد. و هرجا 999 ديديد تبديل به 49 كنيد و هرجا Xaaaaa ديديد با اسم شيت مورد نظرتون جايگزين كنيد

[armey]

سلام دوست عزیز
با این تغییر نشد
من میخوام فایلم صدتایی جدا بشه ولی با تغییر این فرمول این اتفاق نیافتد و باز همون تعداد شیت ایجاد میشه و سطر تفکیک میشه
اگر راهنمایی بفرمایید ممنون میشم