Excel Forum

ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
https://snasui.com/

ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเดิม

https://snasui.com/viewtopic.php?t=4630

Page 1 of 2

ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเดิม

Posted: Mon Apr 29, 2013 9:47 am
by P1649
Data.xls มีการ update ทุก 30 นาที (ไฟล์นี้มีแล้ว)
มีความต้องการให้ Link Data.xls นำข้อมูลจาก Data.xls มาบันทึกเรียงต่อกันไปทุก 30 นาที
ขอความกรุณาจากอาจารย์ด้วยครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Mon Apr 29, 2013 10:44 am
by snasui
:D หากนำมาต่อกันอัตโนมัติ ต้องใช้ VBA ครับ

ถ้าไม่อัตโนมัติ นั่นหมายถึงว่าบรรทัดที่ 1 จะต้องคีย์ด้วยมือเองเพื่อจะบอกว่าเป็นข้อมูลของไฟล์ไหน ไม่ทราบต้องการแบบใดครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Mon Apr 29, 2013 2:41 pm
by P1649
ข้อมูลมีจำนวนมาก ต้องการดึงโดยอัตโนมัติ บันทึกเรียงต่อกับไปในแนว column ทุก 30 นาทีครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Mon Apr 29, 2013 2:48 pm
by snasui
:D การทำเช่นนั้นต้องใช้ VBA ในการจัดการ ต้องเขียนมาเอง ติดตรงไหนค่อยถามกันครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Wed May 01, 2013 7:57 am
by P1649

Code: Select all

Sub run_macro()
Dim on_time As Date
on_time = Now + TimeValue("00:01:00") ' currently its 1 min chnage it
Application.OnTime on_time, "run_macro"
Call add_Data
End Sub

Sub add_Data()
Dim wk As Workbook
'Set wk = Workbooks.Open("C:\Users\admin\Downloads\Link Data.xlsx")
Set wk = Workbooks.Open("D:\Test Link\Link Data.xlsx")
'wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = ThisWorkbook.Sheets(1).Range("a1").Value
wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
ThisWorkbook.Sheets(1).Range("A1:A25").Copy Destination:=wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)
ThisWorkbook.Sheets(1).Range("B1:B25").Copy Destination:=wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)
wk.Save
wk.Close
End Sub
จากโคดข้างต้น มีปัญหา ขอการแก้ไขดังนี้ครับ
1. เริ่มเปิดไฟล์มา VBA ไม่ทำงานจนกว่า จะมีการกด run ใน script ขอแก้ไขให้ทำงานตั้งแต่เปิดไฟล์
2. ไม่ต้องการปิดไฟล์ Link Data.xlsx เพื่อการ monitor
ขอบคุณครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Wed May 01, 2013 8:48 am
by snasui
:D ใน Module ThisWorkbook ก็ต้องใส่ Code ที่เคยโพสต์ไว้เดิมด้วยครับ

จาก Code ที่โพสต์มา ลองปรับเป็นตามด้านล่างครับ

Code: Select all

Sub run_macro()
    Dim on_time As Date
    on_time = Now + TimeValue("00:01:00") ' currently its 1 min change it
    Application.OnTime on_time, "run_macro"
    Call add_Data
End Sub

Sub add_Data()
    Dim wk As Workbook, wb As Workbook
    Dim CurrBook As Workbook, CheckFile As Boolean
    For Each wb In Workbooks
        If wb.Name = "Link Data.xlsx" Then CheckFile = True
    Next wb
    Set CurrBook = ThisWorkbook
    If CheckFile = True Then
        Set wk = Workbooks("Link Data.xlsx")
    Else
        Set wk = Workbooks.Open("D:\Test Link\Link Data.xlsx")
    End If
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value _
        = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(1).Range("A1:B25").Copy _
        Destination:=wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)
    wk.Save
    'wk.Close
End Sub

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Wed May 01, 2013 10:06 am
by P1649
Module ThisWorkBook

Code: Select all

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Application.OnTime nTime, "SaveFile", , False
Application.OnTime on_time, "run_macro", , False
End Sub

Private Sub Workbook_Open()
'Call SaveFile
Call run_macro
End Sub
run-time error 1004
Close file มี error ครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Wed May 01, 2013 10:20 am
by snasui
:D ประกาศตัวแปร on_time ให้เป็น Public ด้วยครับ ให้สังเกตว่าโพสต์เดิมมีการประกาศและใช้ตัวแปร nTime อย่างไร โพสต์นี้ก็ให้ทำลักษณะนั้นครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 2:14 pm
by P1649
CurrBook.Sheets(1).Range("A1:B25").Copy Destination:=wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)

ต้องการ copy มาเป็น Data เช่น ตัวอักษร หรือ ตัวเลข ไม่ต้องการ link ไปที่ ข้อมูลครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 2:26 pm
by snasui
:D อ่านแล้วไม่กระจ่างครับ

การ Copy สามารถวางได้หลายแบบ เช่น วางข้อมูล วางสูตร วางรูปแบบ วางสลับแกน หรือวางแบบ Link ก็ได้

ที่ถามมานี้ต้องการจะวางเฉพาะค่า ไม่ต้องการวางสูตรใช่หรือไม่ครับ หากใช่สามารถปรับ Code เป็น

Code: Select all

CurrBook.Sheets(1).Range("A1:B25").Copy
wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 3:30 pm
by P1649

Code: Select all

Public nTime As Double
Sub SaveFile()
    Dim nTime As Date
    nTime = Now + TimeValue("00:01:00") ' currently its 1 min change it
    Application.OnTime nTime, "SaveFile"
    Call Copy_Data
End Sub

Sub Copy_Data()
    Dim wk As Workbook, wb As Workbook
    Dim CurrBook As Workbook, CheckFile As Boolean
    For Each wb In Workbooks
        If wb.Name = "Link Data.xlsx" Then CheckFile = True
    Next wb
    Set CurrBook = ThisWorkbook
    If CheckFile = True Then
        Set wk = Workbooks("Link Data.xlsx")
    Else
        Set wk = Workbooks.Open("D:\SET Backup\Link Data.xlsx")
    End If
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(3).Range("d2:d51").Copy wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)
    'CurrBook.Sheets(3).Range("j2:j51").Copy wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1)

     CurrBook.Sheets(3).Range("d2:d51").Copy wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
      
    'wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(3).Range("d56:d105").Copy wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1)
    'CurrBook.Sheets(3).Range("j56:j105").Copy wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1)
   
    'wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(4).Range("d2:d51").Copy wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1)
    'CurrBook.Sheets(4).Range("j2:j51").Copy wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1)
    
    'wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(4).Range("d56:d105").Copy wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1)
    'CurrBook.Sheets(4).Range("j56:j105").Copy wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1)

    
    wk.Save
    'wk.Close
End Sub
ต้องการวางข้อมูลครับ แต่ยัง error ในส่วนของ PasteSpecial xlPasteValues
ขอรบกวนช่วยแนะนำด้วยครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 4:03 pm
by snasui
:D สังเกตว่า Code ที่ผมเขียนเป็นตัวอย่าง จะแยกการ Copy และการวางไว้คนละบรรทัด ไม่ได้วางต่อในบรรทัดเดียวกันครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 4:52 pm
by P1649
ตามนี้ ผมยังแก้ error เมื่อปิดไฟล์ยังไม่ได้เลย ทั้งที่ประกาศ nTime เป็น Public แล้ว ขอรบกวนด้วยครับ
ThisWorkbook

Code: Select all

Public nTime As Double
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime nTime, "SaveFile", , False
End Sub

Private Sub Workbook_Open()
Call SaveFile
End Sub
Module1

Code: Select all

Sub SaveFile()
    Dim nTime As Date
    nTime = Now + TimeValue("00:01:00") ' currently its 1 min change it
    Application.OnTime nTime, "SaveFile"
    Call Copy_Data
End Sub

Sub Copy_Data()
    Dim wk As Workbook, wb As Workbook
    Dim CurrBook As Workbook, CheckFile As Boolean
    For Each wb In Workbooks
        If wb.Name = "Link Data.xlsx" Then CheckFile = True
    Next wb
    Set CurrBook = ThisWorkbook
    If CheckFile = True Then
        Set wk = Workbooks("Link Data.xlsx")
    Else
        Set wk = Workbooks.Open("D:\SET Backup\Link Data.xlsx")
    End If
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(3).Range("d2:d51").Copy
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(3).Range("j2:j51").Copy
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
     
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(3).Range("d56:d105").Copy
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(3).Range("j56:j105").Copy
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
   
    wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(4).Range("d2:d51").Copy
    wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(4).Range("j2:j51").Copy
    wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    
    wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(4).Range("d56:d105").Copy
    wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(4).Range("j56:j105").Copy
    wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    
    wk.Save
    'wk.Close
End Sub

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 5:02 pm
by snasui
:D ลองแนบไฟล์ที่ Update ล่าสุดมาดูกัน แจ้งด้วยว่าปัญหา Error ที่เกิดเป็นแบบใดครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 5:20 pm
by snasui
:D จาก Code

Code: Select all

Sub SaveFile()
    Dim nTime As Date
    nTime = Now + TimeValue("00:01:00") ' currently its 1 min change it
    Application.OnTime nTime, "SaveFile"
    Call Copy_Data
End Sub
ให้นำ nTime ออกไปประกาศไว้ที่ Public ครับ การนำมาประกาศไว้ด้านใน Procedure ถือเป็น Private และใช้ใน Procedure SaveFile เท่านั้น เมื่อปิดไฟล์จึงเป็นปัญหาได้ครับ นอกจากนี้ควรประกาศไว้ที่ใดทีหนึ่ง อย่าประกาศซ้ำซ้อน ไม่เช่นนั้นตัวที่ประกาศเป็น Public จะถูกแทนด้วย Private

คร่าว ๆ สำหรับการประกาศตัวแปรครับ
Public คือประกาศแล้วใช้ร่วมกันทั้ง Project
Private คือประกาศแล้วใช้ใน Module ใด ๆ หรือ Procedure ใด ๆ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Sun May 12, 2013 10:23 pm
by P1649
nTime แยกออกไปก็ใช้งานได้ครับ มีเพิ่มเติมคือ ต้องการปิดไฟล์ เวลา 16.00 โดยการเพิ่มเงื่อนไข พบว่า wk.close ทำงานด้วยการปิดไฟล์ แต่ไฟล์หลักยังคงเปิดทำงาน ขอรบกวนช่วยแนะนำด้วยครับ

Code: Select all

Sub Copy_Data
.
.
.
   If Now > TimeValue("16:00:00") Then
    wk.Close
    Exit Sub
    End If

End Sub

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Mon May 13, 2013 5:21 pm
by snasui
:D กรณีต้องการให้ปิดเมื่อถึงเวลาที่กำหนดลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Copy_Data
'Other code
If Now > Date + TimeValue("16:00:00") Then
   Application.OnTime nTime, "SaveFile", , False    
   wk.save
   wk.Close
   Exit Sub
End If
End Sub
กรณีต้องการจะ Save และปิดหลายไฟล์ก็ระบุไฟล์ที่ต้องการ Save และปิดเอาไว้ใน Code ครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Thu May 16, 2013 10:40 pm
by P1649
เงื่อนไขการปิดไฟล์ เวลาหลังจาก 16.00 ยังไม่ทำงาน ขอรบกวนอีกครั้งครับ

Code: Select all

Public nTime As Date
Sub SaveFile()
    nTime = Now + TimeValue("00:15:00") ' currently its 15 min change it
    Application.OnTime nTime, "SaveFile"
    Call Copy_Data
End Sub

Sub Copy_Data()
    Dim wk As Workbook, wb As Workbook
    Dim CurrBook As Workbook, CheckFile As Boolean
    For Each wb In Workbooks
        If wb.Name = "Link Data.xlsx" Then CheckFile = True
    Next wb
    Set CurrBook = ThisWorkbook
    If CheckFile = True Then
        Set wk = Workbooks("Link Data.xlsx")
    Else
        Set wk = Workbooks.Open("D:\SET Backup\Link Data.xlsx")
    End If
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(3).Range("d2:d51").Copy
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(3).Range("j2:j51").Copy
    wk.Sheets(1).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
     
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    CurrBook.Sheets(3).Range("d56:d105").Copy
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    CurrBook.Sheets(3).Range("j56:j105").Copy
    wk.Sheets(2).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
   
    'wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(4).Range("d2:d51").Copy
    'wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    'CurrBook.Sheets(4).Range("j2:j51").Copy
    'wk.Sheets(3).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    
    'wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(-1, 1).Value = Format(Now, "yyyy-mm-dd hh-mm-ss")
    'CurrBook.Sheets(4).Range("d56:d105").Copy
    'wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    'CurrBook.Sheets(4).Range("j56:j105").Copy
    'wk.Sheets(4).Range("xfd2").End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
    
    wk.Save
    'wk.Close

    If Now > Date + TimeValue("16:00:00") Then
        Application.OnTime nTime, "SaveFile", , False
        wk.Save
        wk.Close
        Exit Sub
    End If   

End Sub

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Thu May 16, 2013 10:43 pm
by snasui
:D แนบไฟล์ตัวอย่างมาด้วยเพื่อจะได้ช่วยทดสอบได้ครับ นอกจากนี้ลองตรวจสอบเพิ่มเติมมาด้วยครับว่าเครื่องที่ใช้นั้นกำหนด Regional and Language ไว้เป็นไทยหรือเป็นอย่างอื่นครับ

Re: ดึงข้อมูลจากไฟล์อื่นมาบันทึกทุก 30 นาทีแบบไม่ทับข้อมูลเด

Posted: Thu May 16, 2013 11:28 pm
by P1649
กำหนดให้ ปิดไฟล์หลังจากเวลา 16.00.00 ยังไม่ทำงานครับ
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited