Separate File 83 file

[janry]

มีข้อมูลอยู่ประมาณ 5000 record แยกเป็นไฟล์ ประมาณ 80 กว่า file ซึ่งแต่ละ file จำนวนไม่เท่ากัน น้อยบ้าง มากบ้าง ลอง run ดู ใช้เวลานานพอสมควร พอจะมีวิธีให้ run เร็วกว่านี้ไหมคะ ผ่านไป 10 นาที เพิ่งจะได้ออกมา ประมาณ 10 file

Code ตัวอย่างตามข้างล่างคะ (code จาก forum นำมาปรับใช้คะ)

Option Explicit
Sub SeparateFile()
Dim fName As String, i As Integer
Dim wbs As Workbook, Nwbs As Workbook
Set wbs = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
wbs.Sheets("Entry List").Range("Q7", Range("Q" & Rows.Count)).ClearContents
wbs.Sheets("Entry List").Range("C5:" & "C" & Rows.Count).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Range("Q7"), Unique:=True
For i = 1 To Range("R5").Value
Range("Q6") = Range("Q8", Range("Q" & Rows.Count).End(xlUp))(i)
Set Nwbs = Workbooks.Add
wbs.Sheets("Entry List").Range("1:4").Copy
Nwbs.Activate
Range("A1").Select
ActiveSheet.Paste
wbs.Sheets("Entry List").Range("A5:P" & Rows.Count).AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=wbs.Sheets("Entry List").Range("Q5:Q6"), CopyToRange:=Range("A5")
Range("A1").Select
fName = Range("C6")
ChDir "D:\"
Nwbs.SaveAs Filename:="D:\" & fName
MsgBox fName & " ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÂÃéÍÂáÅéǤèÐ"
Nwbs.Close
Next i
.ScreenUpdating = True
End With
End Sub

[snasui]

Code นี้ไม่น่าจะทำงานช้าครับ ลองดูว่าเป็นไฟล์ที่มีสูตรอยู่จำนวนมากหรือไม่ และสูตรพวกนั้นเป็นสูตรใดบ้าง เนื่องจากทุกการ Filter ใน Code โปรแกรมจะคำนวณทุกครั้ง หากใช้ฟังก์ชั่น Vlookup แบบตรงตัวมาใช้สักคอลัมน์ย่อมส่งผลให้ไฟล์คำนวณช้า ซึ่งช้าด้วยตัวเองอยู่แล้ว ไม่ได้ช้าเพราะ Code วิธีการทำให้เร็วขึ้นลองอ่านกระทู้นี้ประกอบครับ viewtopic.php?p=10312#p10312