:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

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

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#1

Post by P1649 »

Data.xls มีการ update ทุก 30 นาที (ไฟล์นี้มีแล้ว)
มีความต้องการให้ Link Data.xls นำข้อมูลจาก Data.xls มาบันทึกเรียงต่อกันไปทุก 30 นาที
ขอความกรุณาจากอาจารย์ด้วยครับ
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#2

Post by snasui »

:D หากนำมาต่อกันอัตโนมัติ ต้องใช้ VBA ครับ

ถ้าไม่อัตโนมัติ นั่นหมายถึงว่าบรรทัดที่ 1 จะต้องคีย์ด้วยมือเองเพื่อจะบอกว่าเป็นข้อมูลของไฟล์ไหน ไม่ทราบต้องการแบบใดครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#3

Post by P1649 »

ข้อมูลมีจำนวนมาก ต้องการดึงโดยอัตโนมัติ บันทึกเรียงต่อกับไปในแนว column ทุก 30 นาทีครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#4

Post by snasui »

:D การทำเช่นนั้นต้องใช้ VBA ในการจัดการ ต้องเขียนมาเอง ติดตรงไหนค่อยถามกันครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#5

Post 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
ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#6

Post 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
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#7

Post 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 ครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#8

Post by snasui »

:D ประกาศตัวแปร on_time ให้เป็น Public ด้วยครับ ให้สังเกตว่าโพสต์เดิมมีการประกาศและใช้ตัวแปร nTime อย่างไร โพสต์นี้ก็ให้ทำลักษณะนั้นครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#9

Post by P1649 »

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

ต้องการ copy มาเป็น Data เช่น ตัวอักษร หรือ ตัวเลข ไม่ต้องการ link ไปที่ ข้อมูลครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#10

Post 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
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#11

Post 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
ขอรบกวนช่วยแนะนำด้วยครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#12

Post by snasui »

:D สังเกตว่า Code ที่ผมเขียนเป็นตัวอย่าง จะแยกการ Copy และการวางไว้คนละบรรทัด ไม่ได้วางต่อในบรรทัดเดียวกันครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#13

Post 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
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#14

Post by snasui »

:D ลองแนบไฟล์ที่ Update ล่าสุดมาดูกัน แจ้งด้วยว่าปัญหา Error ที่เกิดเป็นแบบใดครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#15

Post 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 ใด ๆ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#16

Post 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
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#17

Post 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 ครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#18

Post 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
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 30922
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:
Contact snasui

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

#19

Post by snasui »

:D แนบไฟล์ตัวอย่างมาด้วยเพื่อจะได้ช่วยทดสอบได้ครับ นอกจากนี้ลองตรวจสอบเพิ่มเติมมาด้วยครับว่าเครื่องที่ใช้นั้นกำหนด Regional and Language ไว้เป็นไทยหรือเป็นอย่างอื่นครับ
Top
P1649
Member
Member
Posts: 85
Joined: Sat Feb 09, 2013 6:37 pm

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

#20

Post by P1649 »

กำหนดให้ ปิดไฟล์หลังจากเวลา 16.00.00 ยังไม่ทำงานครับ
You do not have the required permissions to view the files attached to this post.
Top
Post Reply

Return to “Excel”