dạ vâng dữ liệu khá nhiều nên em muốn tách thành file nhỏ mỗi file tối đa 9000 dòng
Có thể viết 1 siêu hàm dùng cho mọi file không?
Chính vì vậy nên chưa xử lý, chỉ thông báo để chủ đề tài sửa. Và đừng quên câu hỏi "siêu hàm"
Ở đây toàn là dân chữa cháy không hè.
Riêng chủ đề này, siêu hàm (ý là siêu Sub) chỉ cần tách 1 file (đang đứng) thành nhiều file, mỗi file 9000 dòng. Siêu ở chỗ là dùng cho nhiều file cấu trúc khác nhau.
Sub SplitFile ()
'Tìm dòng cuối cột cuối sheet chỉ định cứng rồi thực hiện
End SubSub SplitFile (Sh as WorkSheet, SplitRws as long, NewFName as String)
'---- Tùy chọn sheet, tùy chọn số dòng tách, tùy chọn tên file sẽ lưu (hoặc thêm folder nếu thích)
End SubTôi chạy khoảng 20 giây (500 ngàn dòng x 11 cột, 56 file con)
File hơn 500000 dòng và 15 cột. chạy code của anh Hai Lua Mien Tay hết 73,03125. Dù nén nhưng dung lượng lớn qua quy định không up lên được
Sub Tach_1_SheetThanhNhieuSheet()
Dim sh As Worksheet
Dim SoSheet As Integer, i As Integer
Dim tTime As Double
Const SoDong = 9000
Application.ScreenUpdating = False
Application.DisplayAlerts = False
tTime = Timer
With CreateObject("ADODB.Recordset")
.Open ("Select * from [Sheet1$]"), "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
While Not .EOF
SoSheet = SoSheet + 1
Set sh = Worksheets.Add
sh.Name = "Sheet_" & SoSheet
sh.Range("A3").CopyFromRecordset .DataSource, SoDong
Wend
End With
Debug.Print Timer - tTime
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done"
End SubCode dùng ADO thường chậm hơn mảng.
Dim SourceArr()
SourceArr= Range1.Value
Range2.Value = SourceArrRange2.Value = Range1.ValueThế bạn tách theo tiêu chí nào? Ngày tháng hay tên khách v.v.v.phải có file mẫu ae mới biết mà giúp chứ
Chỗ này là bạn hứa chứ chưa có "a" "e" gì hết nhé.
Tôi thử 500800 dòng 15 cột dùng phương pháp copy và paste hết 10,3s
...
Ws.Range......Copy Sh.range....
...Phương pháp này giống suy nghĩ của em nè... mỗi một lần copy thì tạo file mới rồi pase vào cho gọn, còn lẹ hay không thì em chưa làm nên chưa biết.
Copy paste thành sheet mới thì nhanh hơn copy paste file mới, lưu (tên file mới) và đóng file mới đó.
Cảm ơn anh đã khai sáng.
......
sh.Range("A3").Resize(SoDong, 15).Value = Ws.Cells(i, 1).Resize(SoDong, 15).Value
......Copy nhiều đương nhiên có ảnh hưởng. Số cột nhiều đòi hỏi RAM phải nhiều. Chép lại là có khả năng vào Hard Disk. Mà vào HD thì còn tùy thuộc vào tốc độ của chúng.
Tôi đã thử code lại: (500 ngàn dòng x 15 cột)
Tôi hơi ngạc nhiên. Tạo các sheet trên cùng workbook (giữa copy paste và gán giá trị) sao lại chênh lệch thời gian gấp 7 lần như vậy? Nếu máy yếu thì theo 1 tỷ lệ tương đối sẽ khoảng 13 - 14s thôi chứ?
Tôi đã thử lại cả 3 cách : Chỉ dùng 1 vòng for để lấy dòng cuối
Sub Tach_1_SheetThanhNhieuSheet()
Dim sh As Worksheet, Ws As Worksheet
Dim SoSheet As Integer, i As Long, Lr As Long
Dim tTime As Double
' Dim Rng As Range
' Dim Arr()
Const SoDong = 9000
Application.ScreenUpdating = False
Application.DisplayAlerts = False
tTime = Timer
Set Ws = Sheets("Sheet1")
Lr = Ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lr Step SoDong
' Arr = Ws.Cells(i, 1).Resize(SoDong, 15).Value
SoSheet = SoSheet + 1
Set sh = Worksheets.Add
sh.Name = "Sheet_" & SoSheet
sh.Cells(1, 1) = sh.Name
Ws.Range("A1:O1").Copy sh.Range("A2")
' sh.Range("A3").Resize(SoDong, 15).Value = Arr ' chay hêt 79,533203125s
' Ws.Cells(i, 1).Resize(SoDong, 15).Copy sh.Range("A3") ' chay hêt 10,6171875s
sh.Range("A3").Resize(SoDong, 15).Value = Ws.Cells(i, 1).Resize(SoDong, 15).Value ' chay hêt 69,126953125 s
Next i
Debug.Print Timer - tTime
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done"
End SubTôi chạy code của bạn:
Vậy thì tôi chịu thua.
Điều anh định nói có lẽ là nguyên nhân chính, bởi vì tôi dùng Offce 365 không bản quyền, và cấu hình máy thì ram chỉ có 4 Gb thôi. Cảm ơn anh đã chia sẻ những kinh nghiệm quý cho 1 người a ma tơ- không có căn bản và cũng chả có tý kinh nghiệm nào như tôi.
