EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
Code: Select all
Private Sub CommandButton1_Click()
Dim csvFilePath As String, csvdirF As String, csvdirD As String, iCount As Long, jCount As Long, kCount As Long, maxRow As Long
Dim maxCol As Long, WSH As Variant, fileNo As Integer, FileNameT As String, FileNameD As String
Dim FTY, STN, ctno As Variant
FileNameT = Format(Now(), "hhmmss")
FileNameD = Format(Now(), "yyyymmdd")
Set WSH = CreateObject("WScript.Shell")
FTY = Worksheets("in").Cells(3, 3) 'factory
STN = Worksheets("in").Cells(3, 6) 'stlye
'row/cloum
ctno = Worksheets("in").Cells(1, 8).Value
csvdirF = WSH.SpecialFolders("Desktop") & "\" & FTY
csvdirD = csvdirF & "\" & FileNameD
csvFilePath = csvdirD & "\" & STN & "-CTNo." & ctno & "_" & FileNameT & ".csv"
maxRow = Cells(Rows.Count, 1).End(xlUp).Row
maxCol = Cells(2, Columns.Count).End(xlToLeft).Column
fileNo = FreeFile
Dim sc As Range, tg As Range
Dim tgBook As Workbook
With Sheets("IN")
lr = .Range("A" & Rows.Count).End(xlUp).Row
Set sc = .Range("A3:I10000" & lr)
sc.Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Set tgBook = Workbooks.Open(Filename:="C:\Users\Administrator\Desktop\GF SYTEM\Data.xlsm")
sc.Copy
tgBook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close False
If Dir(csvdirF, vbDirectory) = "" Then
MkDir csvdirF
End If
If Dir(csvdirD, vbDirectory) = "" Then
MkDir csvdirD
End If
Open csvFilePath For Output As #fileNo
For iCount = 1 To maxRow
For jCount = 1 To maxCol - 1
If Not Cells(iCount, jCount) = "" Then
Write #fileNo, Cells(iCount, jCount);
End If
kCount = jCount
Next jCount
Write #fileNo, Cells(iCount, kCount + 1)
Next iCount
Close #fileNo
End With
Sheets("IN").Select
Range("A3:H1048576").Clear
Selection.ClearContents
Sheets("Out").Select
Range("A2:H1048576").Select
Selection.ClearContents
MsgBox "Done:"
Worksheets("IN").Select
Me.TextBox11.Text = Application.WorksheetFunction.Sum(Range("H3:H1048576"))
End Sub
ตอนนี้ที่ทำได้คือเมื่อกดปุ่ม Home และกดปุ่ม Save จะทำการ Save ไฟล์และสร้างโฟเดอร์ ขึ้นมาใหม่ในหน้า Desktop โดยโฟเดอร์ใหม่นั้นจะตั้งชื่อ ใน Cloum C3 และเมื่อกดเข้าไปในโฟเดอร์ใหม่ที่ตั้งชื่อแล้วนั้นจะพบโฟเดอร์ที่สร้างอีก 1 โฟเดอร์เป็นวันที่ที่ทำและเมื่อกดเข้าไปอีกจะพบไฟล์ที่เราบันทึกครับแต่ไฟล์นั้นจะเป็น .Csv และเป็นแค่ชีตเดียว