EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Public Sub saveasfile()
ThisWorkbook.Saveas Filename:="D:\MMCT\Work\ Today()"
End sub
ขอบคุณครับlogic wrote:ตัวอย่างการ Save As ดูได้ที่ลิงก์นี้ครับ http://www.snasui.com/viewtopic.php?t=7111#p45353
นี้ครับตัวอย่างโค้ดsnasui wrote: แนบไฟล์พร้อม Code ที่มีปัญหามาด้วยจะได้สะดวกในการทดสอบครับ
Code: Select all
Sub Macro1()
'
' Macro1 Macro
'
'
Set cell_to = Cells(1, 1)
Set active_workbook = ActiveWorkbook
Set active_sheet = ActiveSheet
Application.DisplayAlerts = False
File_Path = "D:\MMCT\MMCT\excel\"
strName = Dir(File_Path & "\" & "*.csv")
Dim X
Dim Y
Dim z
Y = 2
X = 2
Dim data_sheet As Single
Workbooks("boox1").Worksheets("sheet1").Range("b1441").Value = data_sheet
If data_sheet > 1 Then
Call Macro3
Else
Do While strName <> vbNullString
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("Sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Loop
End If
Application.DisplayAlerts = True
End Sub
Set cell_to = Cells(1, 1)
ไม่ทราบว่า Cells(1, 1)
คือเซลล์ A1 ของชีตใดครับ Workbooks("boox1").Worksheets("sheet1").Range("b1441").Value = data_sheet
Code นี้ boox1 จะต้องเปิดอยู่ก่อนเสมอไม่เช่นนั้นจะ Error ปกติชื่อไฟล์จะต้องมีนามสกุลไฟล์อยู่ด้วย เช่น .xlsx, xlsm ฯลฯ ยกเว้นเป็นไฟล์ที่เปิดขึ้นมาใหม่ยังไม่ได้ Savedata_sheet
คือค่าใด กำหนดตัวแปรไว้ที่ใดครับ ตัวอย่างการปรับ Code ครับnisit2559 wrote:cell A1 เป็นของ ชีด Sheet1 ครับในworkbook("Workbook1.1") ส่วน Boox1 นั้นผมเปิดไว้อยู่แล้วครับ นามสกุลใช้ .xlsx ครับ และ data_sheet oั้นผมจะเอาไว้เก็บข้อมูลใน Boox1 cell(b1441)ครับ
Code: Select all
'Other code
data_sheet = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1441").Value
'Other code
ขอบคุณทำได้แล้วครับแต่ผมขอสอบถามเพิ่มเกี่ยวกับการตั้งเงื่อนไขให้ไม่สามรถดึงข้อมูลซ้ำกันได้ครับจะต้องแก้ไขโค้ดอย่างไรครับsnasui wrote:ตัวอย่างการปรับ Code ครับnisit2559 wrote:cell A1 เป็นของ ชีด Sheet1 ครับในworkbook("Workbook1.1") ส่วน Boox1 นั้นผมเปิดไว้อยู่แล้วครับ นามสกุลใช้ .xlsx ครับ และ data_sheet oั้นผมจะเอาไว้เก็บข้อมูลใน Boox1 cell(b1441)ครับ
Code: Select all
'Other code data_sheet = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1441").Value 'Other code
ขอบคุณครับ ตอนนี้ผมติดปัญหาใหม่แล้วครับคือผมต้องการให้มัน save assnasui wrote: Code ที่เขียนมาเองแล้วคือ Procedure ใด ติดปัญหาบรรทัดใด คำตอบที่ต้องการมีลักษณะเป็นอย่างไร กรุณาอธิบายลำดับขั้นตอนมาอย่างละเอียด และต้องเป็น Code ล่าสุดที่ได้มีการปรับปรุงไปแล้วครับ
Code: Select all
Sub Macro3()
Workbooks("boox1.xlsx").SaveAs Filename:="D:\MMCT\data\" & Worksheets("sheet1").Range("a2").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Workbooks("boox1.xlsx").Worksheets("sheet1").Range("a2:ai1441").ClearContents
End Sub
Code: Select all
'Other code
Workbooks("boox1.xlsx").SaveAs Filename:="C:\Users\snasui\Downloads\" & _
Application.Text(Worksheets("sheet1").Range("a2").Value, "ddmmyyyy") & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Other code
อาจารย์ครับพอผมใช้เซลล์ a2 ไปแล้วแต่พอเซฟออกมาไม่ได้เป็นวันที่ที่ตรงกันครับแล้วพอผมเปลี่ยนไปใช้หน้า Calculation ตรงต่ำแหน่ง g46 มันก็บอกว่าerror ครับsnasui wrote: ตัวอย่างการปรับ Code ครับ
Code: Select all
'Other code Workbooks("boox1.xlsx").SaveAs Filename:="C:\Users\snasui\Downloads\" & _ Application.Text(Worksheets("sheet1").Range("a2").Value, "ddmmyyyy") & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Other code
Code: Select all
Workbooks("boox1.xlsx").SaveAs Filename:="D:\MMCT\data\" & Application.Text(Worksheets("Calculation").Range("g46").Value, "ddmmyyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Code: Select all
Sub copyflie()
Set cell_to = Cells(1, 1)
Set active_workbook = ActiveWorkbook
Set active_sheet = ActiveSheet
Application.DisplayAlerts = False
File_Path = "D:\MMCT\MMCT\excel\"
strName = Dir(File_Path & "\" & "*.csv")
Dim X
Dim Y
Dim z
Y = 2
X = 2
z = 1
Dim data_sheet2 As Single
data_sheet2 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b61").Value
Dim data_sheet3 As Single
data_sheet3 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b121").Value
Dim data_sheet4 As Single
data_sheet4 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b181").Value
Dim data_sheet5 As Single
data_sheet5 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b241").Value
Dim data_sheet6 As Single
data_sheet6 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b301").Value
Dim data_sheet7 As Single
data_sheet7 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b361").Value
Dim data_sheet8 As Single
data_sheet8 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b421").Value
Dim data_sheet9 As Single
data_sheet9 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b481").Value
Dim data_sheet10 As Single
data_sheet10 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b541").Value
Dim data_sheet11 As Single
data_sheet11 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b601").Value
Dim data_sheet12 As Single
data_sheet12 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b661").Value
Dim data_sheet13 As Single
data_sheet13 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b721").Value
Dim data_sheet14 As Single
data_sheet14 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b781").Value
Dim data_sheet15 As Single
data_sheet15 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b841").Value
Dim data_sheet16 As Single
data_sheet16 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b901").Value
Dim data_sheet17 As Single
data_sheet17 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b961").Value
Dim data_sheet18 As Single
data_sheet18 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1021").Value
Dim data_sheet19 As Single
data_sheet19 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1081").Value
Dim data_sheet20 As Single
data_sheet20 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1141").Value
Dim data_sheet21 As Single
data_sheet21 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1201").Value
Dim data_sheet22 As Single
data_sheet22 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1261").Value
Dim data_sheet23 As Single
data_sheet23 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1321").Value
Dim data_sheet24 As Single
data_sheet24 = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1381").Value
If data_sheet2 > 0 Then
For i = 1 To 2
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
dataset_workbook.Close
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
Next
If data_sheet3 > 0 Then
For i = 1 To 4
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
dataset_workbook.Close
Next
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
End If
If data_sheet4 > 0 Then
For i = 1 To 6
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
dataset_workbook.Close
Next
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
End If
If data_sheet5 > 0 Then
For i = 1 To 4
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
dataset_workbook.Close
Next
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
End If
If data_sheet6 > 0 Then
For i = 1 To 4
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
dataset_workbook.Close
Next
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
End If
Else
For z = 1 To 2
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("boox1.xlsx").Activate
Sheets("Sheet1").Select
Cells(Y, 2).Select
ActiveSheet.Paste
Worksheets("sheet1").Cells(X, 1).Value = Now()
Y = Y + RowInc
X = X + RowInc
dataset_workbook.Close
End If
strName = Dir
Next
End If
End Sub
ช่วยอธิบายคำว่าไม่ได้เป็นวันที่ที่ตรงกัน แนบไฟล์ที่เป็นปัญหามาใหม่ ขอให้เคลียร์ไปทีละปัญหาก่อนที่จะถามต่อเนื่องไปครับnisit2559 wrote: อาจารย์ครับพอผมใช้เซลล์ a2 ไปแล้วแต่พอเซฟออกมาไม่ได้เป็นวันที่ที่ตรงกันครับแล้วพอผมเปลี่ยนไปใช้หน้า Calculation ตรงต่ำแหน่ง g46 มันก็บอกว่าerror ครับCode: Select all
Workbooks("boox1.xlsx").SaveAs Filename:="D:\MMCT\data\" & Application.Text(Worksheets("Calculation").Range("g46").Value, "ddmmyyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
นี้ครับตัวอย่างชื่อไฟล์แล้วพอจะทำงานต่อให้มันเคลียร์ข้อมูลเก่าก็ทำไม่ได้เพราะว่ามันไม่เจอไฟล์เก่าต้องทำอย่างไรครับsnasui wrote:ช่วยอธิบายคำว่าไม่ได้เป็นวันที่ที่ตรงกัน แนบไฟล์ที่เป็นปัญหามาใหม่ ขอให้เคลียร์ไปทีละปัญหาก่อนที่จะถามต่อเนื่องไปครับnisit2559 wrote: อาจารย์ครับพอผมใช้เซลล์ a2 ไปแล้วแต่พอเซฟออกมาไม่ได้เป็นวันที่ที่ตรงกันครับแล้วพอผมเปลี่ยนไปใช้หน้า Calculation ตรงต่ำแหน่ง g46 มันก็บอกว่าerror ครับCode: Select all
Workbooks("boox1.xlsx").SaveAs Filename:="D:\MMCT\data\" & Application.Text(Worksheets("Calculation").Range("g46").Value, "ddmmyyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Code: Select all
Sub saveflie()
Workbooks("boox1.xlsx").SaveAs Filename:="D:\MMCT\data\" & Application.Text(Worksheets("Calculation").Range("G46").Value, "ddmmyyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Workbooks("boox1.xlsx").Worksheets("sheet1").Range("a2:ai1441").ClearContents
End Sub