Page 2 of 3
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Fri Oct 20, 2017 7:38 am
by nisit2559
แสดงว่าผมต้องเขียนโค้ดให้เช็คทุกครั้งที่มีการเปิดไฟล์ขึ้นมาเลยใช้ไหมครับ แล้วเวลาเซฟนี้สามารถเขียนโค้ดอย่างนี้เพื่อให้มันเชฟอัตโนมัตเป็นชื่อวันที่ได้ไหมครับ
Code: Select all
Public Sub saveasfile()
ThisWorkbook.Saveas Filename:="D:\MMCT\Work\ Today()"
End sub
ขอบคุณครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Fri Oct 20, 2017 2:11 pm
by logic
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Fri Oct 20, 2017 3:43 pm
by nisit2559
ขอบคุณครับ

Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Fri Oct 20, 2017 4:01 pm
by nisit2559
IMG_0830[1].jpg
IMG_0831[1].jpg
สอบถามเกี่ยวกับการแสดงเงื่อนไขครับมันขึ้นเออเรอดังรูปต้องแก้อย่างไรครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Fri Oct 20, 2017 7:45 pm
by snasui

แนบไฟล์พร้อม Code ที่มีปัญหามาด้วยจะได้สะดวกในการทดสอบครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Mon Oct 23, 2017 7:36 am
by nisit2559
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
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Mon Oct 23, 2017 8:57 am
by snasui

ค่อย ๆ ถามตอบกันไปครับ
จาก
Set cell_to = Cells(1, 1) ไม่ทราบว่า
Cells(1, 1) คือเซลล์ A1 ของชีตใดครับ
Workbooks("boox1").Worksheets("sheet1").Range("b1441").Value = data_sheet Code นี้ boox1 จะต้องเปิดอยู่ก่อนเสมอไม่เช่นนั้นจะ Error ปกติชื่อไฟล์จะต้องมีนามสกุลไฟล์อยู่ด้วย เช่น .xlsx, xlsm ฯลฯ ยกเว้นเป็นไฟล์ที่เปิดขึ้นมาใหม่ยังไม่ได้ Save
ตัวแปร
data_sheet คือค่าใด กำหนดตัวแปรไว้ที่ใดครับ

Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Mon Oct 23, 2017 10:10 am
by nisit2559
cell A1 เป็นของ ชีด Sheet1 ครับในworkbook("Workbook1.1") ส่วน Boox1 นั้นผมเปิดไว้อยู่แล้วครับ นามสกุลใช้ .xlsx ครับ และ data_sheet oั้นผมจะเอาไว้เก็บข้อมูลใน Boox1 cell(b1441)ครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Mon Oct 23, 2017 8:38 pm
by snasui
nisit2559 wrote:cell A1 เป็นของ ชีด Sheet1 ครับในworkbook("Workbook1.1") ส่วน Boox1 นั้นผมเปิดไว้อยู่แล้วครับ นามสกุลใช้ .xlsx ครับ และ data_sheet oั้นผมจะเอาไว้เก็บข้อมูลใน Boox1 cell(b1441)ครับ
ตัวอย่างการปรับ Code ครับ
Code: Select all
'Other code
data_sheet = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1441").Value
'Other code
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Tue Oct 24, 2017 8:44 am
by nisit2559
snasui wrote:nisit2559 wrote:cell A1 เป็นของ ชีด Sheet1 ครับในworkbook("Workbook1.1") ส่วน Boox1 นั้นผมเปิดไว้อยู่แล้วครับ นามสกุลใช้ .xlsx ครับ และ data_sheet oั้นผมจะเอาไว้เก็บข้อมูลใน Boox1 cell(b1441)ครับ
ตัวอย่างการปรับ Code ครับ
Code: Select all
'Other code
data_sheet = Workbooks("boox1.xlsx").Worksheets("sheet1").Range("b1441").Value
'Other code
ขอบคุณทำได้แล้วครับแต่ผมขอสอบถามเพิ่มเกี่ยวกับการตั้งเงื่อนไขให้ไม่สามรถดึงข้อมูลซ้ำกันได้ครับจะต้องแก้ไขโค้ดอย่างไรครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Tue Oct 24, 2017 11:17 am
by snasui

Code ที่เขียนมาเองแล้วคือ Procedure ใด ติดปัญหาบรรทัดใด คำตอบที่ต้องการมีลักษณะเป็นอย่างไร กรุณาอธิบายลำดับขั้นตอนมาอย่างละเอียด และต้องเป็น Code ล่าสุดที่ได้มีการปรับปรุงไปแล้วครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Wed Oct 25, 2017 7:50 am
by nisit2559
snasui wrote:
Code ที่เขียนมาเองแล้วคือ Procedure ใด ติดปัญหาบรรทัดใด คำตอบที่ต้องการมีลักษณะเป็นอย่างไร กรุณาอธิบายลำดับขั้นตอนมาอย่างละเอียด และต้องเป็น Code ล่าสุดที่ได้มีการปรับปรุงไปแล้วครับ
ขอบคุณครับ ตอนนี้ผมติดปัญหาใหม่แล้วครับคือผมต้องการให้มัน save as
เป็นไฟล์ .xlsxและให้มันใช้ข้อมูลในcell a2 ในการนำมาตั้งชื่อครับซึ่งได้ทำตามตัวอย่างโค้ด
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
แล้วมันขึ้นว่า error 1004 ครับโดยใช้ไฟล์เก่าเลยครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Wed Oct 25, 2017 10:48 pm
by snasui

ตัวอย่างการปรับ 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
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Sun Oct 29, 2017 10:03 pm
by nisit2559
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
อาจารย์ครับพอผมใช้เซลล์ 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
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Tue Oct 31, 2017 10:18 am
by nisit2559
ขอสอบถามเพิ่มเติมครับผมทำให้สามารถดึงไฟล์แบบไม่ซ้ำกันได้แล้วแต่ว่าโค้มมันยาวไปครับจึงอยากจะอย่โค้ดลงไปอีกไม่ทราบว่าจะต้องปรับอย่างไรบ้างครับหรื่อว่าสามารถใช้ฟังชันหรือการส่งถ่ายตัวแปรได้ไหมครับ
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
ขอบคุณครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Tue Oct 31, 2017 8:33 pm
by snasui
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

ช่วยอธิบายคำว่าไม่ได้เป็นวันที่ที่ตรงกัน แนบไฟล์ที่เป็นปัญหามาใหม่ ขอให้เคลียร์ไปทีละปัญหาก่อนที่จะถามต่อเนื่องไปครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Wed Nov 01, 2017 11:32 am
by nisit2559
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

ช่วยอธิบายคำว่าไม่ได้เป็นวันที่ที่ตรงกัน แนบไฟล์ที่เป็นปัญหามาใหม่ ขอให้เคลียร์ไปทีละปัญหาก่อนที่จะถามต่อเนื่องไปครับ
นี้ครับตัวอย่างชื่อไฟล์แล้วพอจะทำงานต่อให้มันเคลียร์ข้อมูลเก่าก็ทำไม่ได้เพราะว่ามันไม่เจอไฟล์เก่าต้องทำอย่างไรครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Wed Nov 01, 2017 10:19 pm
by snasui

ไม่พบ Code ในไฟล์แนบครับ
ลักษณะการ Save ตาม Code ที่ผมตอบไปด้านบนเป็นการให้ชื่อไฟล์เป็น วัน เดือน ปี ช่วยอธิบายเรื่องการ Clear ข้อมูลเก่าว่าพิจาณาจากไฟล์เก่าอย่างไร ใช้ชื่อไฟล์มาช่วยในการพิจาณาหรือไม่ ข้อมูลเก่าที่กล่าวถึงคือข้อมูลที่ไหน อย่างไร ฯลฯ พร้อมแนบ Code สำหรับการทำงานนั้นมาด้วยจะได้เข้าถึงปัญหาโดยไวครับ
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Thu Nov 02, 2017 7:37 am
by nisit2559
นี้ครับตัวอย่างโค้ดคือว่าพอมัน save as ไปแล้วทำให้ชื่อไฟล์มันเปลี่ยนไปทำให้โค้ดไม่เจอกับชื่อไฟล์เก่าครับ
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
Re: สอบถามเกี่ยวกับโค้ดดึงข้อมูลครับ
Posted: Thu Nov 02, 2017 8:12 pm
by snasui

ไม่เข้าใจครับ ชื่อไฟล์เก่าคือไฟล์ใด ช่วยอธิบายลงรายละเอียดของปัญหามาด้วยจะได้เข้าถึงปัญหาโดยเร็วครับ