มีปัญหาเรื่อง Application.OnTime อัพเดทซ้อนกันครับ(แนบไฟล์มา

[MinkkungZ]

คือตอนนี้ผมมีปัญหาเรื่องการ ใช้ Application.OnTime ครับ ผมได้ทำตัวจำลองการจับเวลาอัพเดทขึ้น Sheet ทีละบรรทัดครับ ในโค้ดจะให้อัพเดททีละบรรทัดทุก 5 วินาทีครับ แต่เมื่อมีการกด Stop หยุดการจับเวลา แล้วกดเริ่มจับเวลาใหม่ ลักษณะการจับเวลาไม่ได้เพิ่มทีละบรรทัดทุก 5 วินาทีครับ แต่กลับกลายเป็นว่าเพิ่มทีละ ครั้ง ละ 2-3 บรรทัด แล้วยิ่ง กด Start Stop Start Stop สลับกัน ค่าเวลาที่อัพเดททุกๆบรรทัดจะยิ่งเพี้ยนครับ ไม่ได้ขึ้นบรรทัดใหม่ทุก 5 วินาที ดั่งแต่แรก ช่วยตรวจสอบโค้ดที่ผมแนบมาในชีทด้วยครับ ว่าควรแก้ตรงไหนขอบคุณมากครับ

[snasui]

ลองปรับ Code ที่ CommandButton2 เป็นตามด้านล่างครับ

Code: Select all

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "update", , False
End Sub

[MinkkungZ]

ขอบคุณมากๆครับ อาจารย์ ตอนนี้ไม่มีปัญหาแล้วครับ ผมนำการเขียนนี้ไปประยุกต์ใช้กับ มิเตอร์ วัดค่าอัตโนมัติหนะครับเวลาเราหยุด Monitor แล้วจะ Monitor ต่อ ค่าที่ได้จะไม่ตรงตามที่เราต้องการ ช่วยได้มากเลยครับขอบพระคุณครับ

[MinkkungZ]

อาจารย์ครับ ปัญหามาอีกแล้วครับ ผมได้เพิ่มฟังก์ชั่น Combobox เพื่อเลือกช่วงนับเวลาลงไป และก็มี Tesxbox ใน Form เพื่อจับเวลาปกติ ขณะที่ผมทำแค่จับเวลาปกติยังไม่ได้นำ Textbox มาใช้งาน ค่านับเวลาที่ Sheet ปกติครับไม่ว่าจะเลือก 1,2, 3, 4, 5, 6 วินาที แล้ว Stop แล้วเริ่มใหม่ก็ปกติครับ แต่เมื่อ มีการใช้ Textbox ให้จับเวลาลงใน Form ค่าที่อ่านในชีท เมื่อกดนับเวลาแล้วหยุดแล้วกดใหม่ก็จะเพี้ยน เหมือนเดิมครับควรแก้ไขตรงไหนดีครับ

[snasui]

ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

ที่ CommandButton1 ปรับ Code เป็น

Code: Select all

Private Sub CommandButton1_Click()
    If ComboBox1.Text = "" Then Exit Sub
    CommandButton1.Enabled = False
    startTime = Now()
    ActiveSheet.Range(Cells(1, 1), Cells(200, 1)).Clear
    continueTime = True
    row = 1
    If ComboBox1.ListIndex = 0 Then
        AddTime = TimeValue("0:00:01")
    ElseIf ComboBox1.ListIndex = 1 Then
        AddTime = TimeValue("0:00:02")
    ElseIf ComboBox1.ListIndex = 2 Then
        AddTime = TimeValue("0:00:03")
    ElseIf ComboBox1.ListIndex = 3 Then
        AddTime = TimeValue("0:00:04")
    ElseIf ComboBox1.ListIndex = 4 Then
        AddTime = TimeValue("0:00:05")
    ElseIf ComboBox1.ListIndex = 5 Then
        AddTime = TimeValue("0:00:06")
    End If
    update0
End Sub

ที่ Module1 ปรับ Code เป็น

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long
Public nextTime As Date
Public startTime As Date
Public AddTime As Date

Sub update0()
    On Error Resume Next
    If continueTime Then
        nextTime = Now() + AddTime
        ActiveSheet.Cells(row, 1).Select
        Cells(row, 1).Value = Format$(Now() - startTime, "hh:nn:ss")
            row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub

สังเกตว่าใช้ Procedure ที่ชื่อว่า Update0 เพียงตัวเดียวและใช้ AddTime เป็นตัวแปรให้รับค่าเวลามาจากที่กำหนดไว้ใน CommandButton1 แทนการใช้ Sub Procedure หลาย ๆ ตัว

ที่ CommandButton2 ปรับ Code เป็น

Code: Select all

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "update0", , False
End Sub

[MinkkungZ]

แก้ไขแล้วครับ โปรแกรมสั้นมากเลยขอบคุณครับ และในส่วนของ Textbox1 หนะครับ ที่ผมเอาไว้ไว้จับเวลาในตัวฟอร์มหนะครับ สมมุติว่ามีการกดจับเวลาที่ 6 วินาที ครั้งแรก ขึ้นบรรทัดทุก 6 วินาทีครับ พอมีการ stop แล้ว start ใหม่ หรือ กด start stop สลับกันไปค่าก็กลับมาเพี้ยนครับ แต่เมื่อผมไม่ได้ใช้ textbox1 ค่าก็ปกติครับ ผมไม่สามารถใช้ Textbox ขึ้นบน Form ควบคู่ไปด้วยกันได้หรือครับ หรืออย่างไร

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code ที่ UsererForm1

Code: Select all

Private Sub CommandButton1_Click()
    If ComboBox1.Text = "" Then Exit Sub
    CommandButton1.Enabled = False
    startTime = Now()
    startTime1 = Now()
    ActiveSheet.Range(Cells(1, 1), Cells(200, 1)).Clear
    continueTime = True
    row = 1
    If ComboBox1.ListIndex = 0 Then
        AddTime = TimeValue("00:00:01")
    ElseIf ComboBox1.ListIndex = 1 Then
        AddTime = TimeValue("00:00:02")
    ElseIf ComboBox1.ListIndex = 2 Then
        AddTime = TimeValue("00:00:03")
    ElseIf ComboBox1.ListIndex = 3 Then
        AddTime = TimeValue("00:00:04")
    ElseIf ComboBox1.ListIndex = 4 Then
        AddTime = TimeValue("00:00:05")
    ElseIf ComboBox1.ListIndex = 5 Then
        AddTime = TimeValue("00:00:06")
    End If
    Update0
    UpdateTime
End Sub

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "Update0", , False
    Application.OnTime nextTime1, "UpdateTime", , False
End Sub

Private Sub CommandButton3_Click()
   Unload Me
End Sub

Private Sub UserForm_Activate()
    With UserForm1.ComboBox1
        .AddItem "1 sec", 0
        .AddItem "2 sec", 1
        .AddItem "3 sec", 2
        .AddItem "4 sec", 3
        .AddItem "5 sec", 4
        .AddItem "6 sec", 5
    End With
End Sub

Code ที่ Module1

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long
Public nextTime As Date
Public nextTime1 As Date
Public startTime As Date
Public startTime1 As Date
Public AddTime As Date

Sub Update0()
    On Error Resume Next
    If continueTime Then
        nextTime = Now() + AddTime
        ActiveSheet.Cells(row, 1).Select
        Cells(row, 1).Value = Format$(Now() - startTime, "hh:nn:ss")
        row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub

Sub UpdateTime()
    On Error Resume Next
    If continueTime Then
        nextTime1 = Now() + TimeValue("00:00:01")
        UserForm1.TextBox1.Text = Format$(Now() - startTime1, "hh:nn:ss")
        Application.OnTime nextTime1, "UpdateTime"
    End If
End Sub

[monstersoza]

คุณ MinkkungZ ผมเห็นว่าโปรแกรมของคุณมีประโยชน์ต่อผมมากๆผมขอพัฒนาต่อจากที่เขียนไว้ครับ แต่ตอนนี้ผมมีปัญหาเรื่องการคัดลอกข้อมูลที่เเรมด้อมมาไปสร้างกราฟใน Sheetใหม่ โดยผมทำการศึกษาต่อจากที่เขียนไว้ เเต่ผมมีปัญหาเรื่องการไม่เเสดงผลใน Sheet1 ซึ่งเเถวเเรกสุดจะทำการคัดลอกชื่อมาว่าเเล้วค่าที่เเรมด้อมจะมาเก็บไว้ในเเต่ละคอลัมน์ทุกๆ5วินาที เเละเราสมารถเพิ่มเเถวข้อมูลได้ตลอดเวลา ผมต้องเเก้ไขงานอย่างไรหรือครับ

ที่ได้ศึกษาก็จะมี :วิธีสั่งให้ VBA ทำงานทวนซ้ำหลายรอบ , Real time clock in excel worksheet, Excel to copy realtime data and create a chart out of it, มีปัญหาเรื่อง Application.OnTime อัพเดทซ้อนกันครับ, Excel VBA Combo Box

[snasui]

ที่มีปัญหาชื่อว่าอะไร ติดที่บันทัดใดครับ

[monstersoza]

ขอโทษอาจารย์ snasui ครับที่อธิบายไม่ระเอียดพอ คือผมติดปัญหาที่การคัดลอกข้อมูลจาก Sheet powerex ไปยัง sheet1 ครับคือผมต้องการให้มันเก็บค่าคอลัมน์ name มาวางไว้ในเเถวเเรกของ sheet1 และเลื่อนไปทางซ้ายของเเถวเช่น ในSheet1 11CG อยู่ช่อง A1 12CG อยู่ช่อง A2 ที่คัดลอกมากจาก sheet powerex ครับและอีก1ปัญหาคือ ทุกๆทีข้อมูล value ใน sheet powerex เปลี่ยน (ค่าจะเเรมด้อม) ให้คัดลอกมาวางต่อจากชื่อใน Sheet1 ต่อจากคอลัมน์ ที่เป็นชื่อเนมของตัวเอง

ดังตัวอย่างนี้ครับ

Code: Select all

sheet PowerEx    
id	name	description	type	        value	       unit	      time	                staus
1	11CG	gas 01	     analog  	0.153381591	MW	4/4/2014 20:16	Good
2	12CG	gas 02	     analog	        0.823648765	MW	4/4/2014 20:17	Good

**คอลัม value ข้อมูลจะเเรมด้อม

sheet sheet1
         A                         B
11CG                        12CG
0.153381591            0.823648765
x  5 sec ผ่านไป             y  5 sec ผ่านไป
x  5 sec ผ่านไป             y  5  sec ผ่านไป
x  5 sec ผ่านไป             y  5 sec ผ่านไป

ประมาณนี้ครับคือสามารถเพิ่มข้อมูลใน sheet Powerex ได้ตลอดเเล้วสามารถเก็บข้อมูลลจากsheet Powerex  ลงใน sheet1 ได้ เเล้วทำตามรูปแบบตัวอย่างและสร้างกราฟเส้นดูค่าเปลี่ยนแปลงได้ใน sheet1 ได้ครับ

ส่วน code ที่มีปัญหามีดังนี้ครับ
code ที่ moudle 1

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long, ws1 As Long, wsPx As Long
Public column As Long
Public nextTime As Date
Public startTime As Date
Public AddTime As Date


Sub Update0()
    On Error Resume Next
    If continueTime Then
                nextTime = Now() + AddTime
        Do Until Selection.Value = ""
              Application.Calculate
              ws1.Value = Worksheets("Sheet1").Cells(row + 1, 1).End(xlUp).Offset(1, 0).Select
              wsPx.Value = Worksheets("PowerEx").Range("E" & Cells(row + 1, 5)).End(xlUp).Offset(1, 0).Select
              ws1.Value = wsPx.Value
        Loop
           row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub


Sub UpdateTime()

    On Error Resume Next
    If continueTime Then

        nextTime = Now() + TimeValue("00:00:01")

        UserForm1.TextBox1.Text = Format$(Now() - startTime, "hh:nn:ss")
        Application.OnTime nextTime, "UpdateTime"

    End If

End Sub

code ที่ moudle2

Code: Select all

Dim row1 As Long
Sub CopyAuto()

    
    row1 = 1
    Do Until Selection.Value = "" 
          Worksheets("PowerEx").Select
          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
          Selection.Copy
          Worksheets("Sheet1").Select
           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
          ActiveSheet.Paste
           row1 = row1 + 1
           Application.CutCopyMode = False
      Loop
      Application.OnTime nextTime, "CopyAuto"
End Sub

code ที่ UseForm1

Code: Select all

Private Sub CommandButton4_Click()
       Worksheets("Sheet1").Range("A" & Cells(Rows.Count, 1).End(xlUp).row + 1).Select
       ActiveSheet.Shapes.AddChart.Select
       ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$B$100")
      ActiveChart.ChartType = xlLineMarkers
End Sub

ถ้ามีส่วนใดที่ผิดอย่างไรช่วยเเนะนำด้วยนะครับ

[snasui]

ให้ระบุ Code และบรรทัดที่เป็นปัญหามาเลยครับ ผู้ตอบจะได้เข้าถึงข้อมูลโดยไว ที่ยกทั้งหมดนั้นมีปัญหาทั้งหมดใช่หรือไม่ หรือมีปัญหาที่บรรทัดใด ระบุมาเฉพาะบรรทัดนั้นๆ ครับ

ยกตัวอย่างปัญหาแรกก่อนซึ่งเป็นการวางข้อมูล Code นั้นชื่อว่าอะไร ติดปัญหาที่บรรทัดใดครับ คำว่าติดปัญหาอาจจะหมายถึง ไม่วางข้อมูลให้ หรือ วางข้อมูลผิดที่ เช่นนี้เป็นต้น ค่อย ๆ แก้ปัญหาไปทีละเปลาะครับ

นอกจากนี้ควรแจ้งวิธีทดสอบว่าต้องคลิก เลือกข้อมูลใด ที่ไหน อย่างไร เป็นลำดับมาด้วยครับ

[monstersoza]

คือที่กล่าวมาเป็นปัญหาทั้งหมดเลยนะครับ
1.ผมใส่วนลูปลงไป การคัดลอกที่ทำได้ไม่ทำงานต่อ
code ที่ moudle 1 ส่วน Update0

Code: Select all

 
Do Until Selection.Value = ""
              Application.Calculate
              ws1.Value = Worksheets("Sheet1").Cells(row + 1, 1).End(xlUp).Offset(1, 0).Select
              wsPx.Value = Worksheets("PowerEx").Range("E" & Cells(row + 1, 5)).End(xlUp).Offset(1, 0).Select
              ws1.Value = wsPx.Value
Loop

**ไม่มีการเเสดงผลใน sheet1

2.code ที่ moudle2 ก็เรื่องวนลูปในส่วนการคัดลอก name

Code: Select all

Do Until Selection.Value = "" 
          Worksheets("PowerEx").Select
          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
          Selection.Copy
          Worksheets("Sheet1").Select
           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
          ActiveSheet.Paste
           row1 = row1 + 1
           Application.CutCopyMode = False
      Loop

*ไม่มีการเเสดงผลใน sheet1

3.เรื่องกราฟที่ต้องมีข้อมูลที่ได้จากการเก็บแบบreal time จาก sheet PowerEx มาใส่ลงใน sheet1 ซึ่งผมไม่รู้จะกำหนดขอบเขตของข้อมูลอย่างไร
ประมาณว่า ถ้า user1 เพิ่มข้อมูลใน sheet PowerEx มา 6 id ก็จะมาเเสดงผลที่ sheet1 คือ 6 คอลัมน์เเล้วก็เก็บข้อมูลเหมือนตัวอย่าง แต่ถ้า
user2 เพิ่มข้อมูลใน sheet PowerEx มา 2 id ก็จะมาเเสดงผลที่ sheet1 เเค่ 2 คอลัมน์เเล้วก็เก็บข้อมูลเหมือนตัวอย่าง ครับ

4.การใช้โปรแกรมก็คือ
4.1เปิดไฟล์ขึ้นมาเพิ่มข้อมูลในsheet PowerEx ว่าจะใช้กี่บรรทัดเเล้วเเต่ผู้ใช้ต้องการ
4.2ไป sheet1 กด show menu เลือกเวลาที่จะเก็บ >> กด start ข้อมูลก็จะทำการเก็บแบบ real time >> การ stop เมื่อต้องการข้อมูลเท่านี้แล้วแต่ user
>> กด make graph เพิ่อสร้างกราฟขึ้นมา (คือกราฟที่สร้างนี้จะนำไปใช้ในงานอื่นๆอีกเเล้วแต่งาน) >> ถ้าต้องการลบกราฟก็กด delete graph >> เมื่อเสร็จสุดก็จะทำการกด exit ครับ

[snasui]

ลองวางตัวอย่างคำตอบด้วย Manual มาที่ Sheet1 ด้วยครับ จะได้เห็นว่าข้อมูล name และ value ที่ต้องการให้วางนั้น เมื่อวางแล้วมีลักษณะเป็นอย่างไร จะได้เข้าใจตรงกัน

[monstersoza]

ผมได้ทำการ Manual คำตอบที่ต้องการลงไปยังใน Sheet1 เเล้วครับ ตามที่แนบไฟล์ พร้อมกับอธิบายไว้เเล้วนะครับ ถ้ามีข้อแนะนำช่วยชี้เเนะด้วยนะครับ

[snasui]

Code ควรจะ Run ให้ผ่านไปทีละ Code ก่อนครับ

สำหรับการ Copy ลองปรับเป็นตามด้านล่างครับ Run Code นี้ให้ผ่านก่อนแล้วค่อยถาม Code ต่อ ๆ ไป

Code: Select all

Dim h As Boolean

Sub CopyAuto()

' กำหนดคัดลอกวางออโต้ชื่อของเส้น
    If h = False Then
        Worksheets("PowerEx").Select
        Range("b2", Range("b" & Rows.Count).End(xlUp)).Copy
        Worksheets("Sheet1").Range("a1").PasteSpecial xlPasteValues, _
            Transpose:=True
        h = True
    End If
    Worksheets("PowerEx").Select
    Range("e2", Range("e" & Rows.Count).End(xlUp)).Copy
    Worksheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues, Transpose:=True
    Application.CutCopyMode = False

'    row1 = 1 'row1 เก็บค่า1 ไว้
'    Do Until Selection.Value = ""  'สั่งให้ทวนจนกว่าจะเจอช่องว่าง
'          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
'          Selection.Copy
'          Worksheets("Sheet1").Select
'           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
'          ActiveSheet.Paste
'           row1 = row1 + 1
'           Application.CutCopyMode = False
'      Loop
      Application.OnTime nextTime, "CopyAuto"
End Sub

[monstersoza]

ขอบคุณมากๆครับ แต่ผมมีปัญหาอีกเรื่องครับคือพอเราสร้างกราฟจุดมาเเล้วข้อมูลกราฟที่สร้างมันเพี้ยนไปจากที่คิดไว้ คือเส้นกราฟไม่ใช่ชื่อของเส้นนั้นเเต่กลับเป็นชุดข้อมูล 1 2 3 เเทน เเต่จะเกิดขึ้นตอนข้อมูลที่เก็บนั้นน้อยกว่า5-6บรรทัด จะมีวิธีเเก้ไขปัญหานี้ได้หรือไม่ครับ หรือต้องเเจ้งให้ user ที่เก็บข้อมูลมากกว่านั้นจะได้เเก้ไขปัญหานี้แทนครับ แต่ user บางครั้งก็ใช้ข้อมูลไม่เท่ากันอยู่ดีครับ เลยต้องการหาทางเเก้ไข

code ที่ moudle2

Code: Select all

Sub MarkGraph()
'สร้างกราฟ
    On Error Resume Next
     Worksheets("Sheet1").Range("A" & Cells(Rows.Count, 1).End(xlUp).row + 1).Select
      ActiveSheet.Shapes.AddChart.Select
      ActiveChart.ChartType = xlLine   ' เปลี่ยนกราฟเส้น
      ActiveChart.SetSourceData Source:=Range("$A$1").Select
      Selection.End(xlUp).Select
      Selection.End(xlToLeft).Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
'      ActiveChart.ChartType = xlLine      วางตรงนี้เเล้วเปลี่ยนการเป็นกราฟเส้นไม่ได้
End Sub

**เป็นไฟล์ Manual นะครับ

[snasui]

ผมทดสอบแล้วไม่พบว่ามีปัญหาตามที่อธิบายมา ช่วยจับภาพตอบที่มีปัญหาแนบมาด้วยครับ

[monstersoza]

ขออภัยครับผมลืมอัพรูปเป็นตัวอย่างให้ทราบ คือ ปัญหาทื่ผมเป็นกราฟเส้นตรงชื่อจะเป็นชุดข้อมูลที่ 1 เเต่ที่จริงต้องเป็นตามชื่อที่เราใส่ไว้ครับ

ปัญหาที่เกิดขึ้น (ผิดพลาด) คือชื่อเส้นเป็น ชุดข้อมูลที่ 1 2 3 4 5 ฯ ตามรูปด้านล่างครับ

p000040514 (Custom).jpg

สิ่งที่ต้องการให้เป็น (ถูกต้อง) คือ ชื่อเส้นจะเเสดง ตามเเถวที่หนึ่งโดนเรียงมาเป็นลำดับ ตามรูปด้านล่างครับ

p001040514 (Custom).jpg

**ทั้งนี้ผมเเค่เพิ่มข้อมูลเเค่1เเถวเท่านั้น ซึ่งเปลี่ยนจากรูปด้านบนเป็นรูปด้านล่างเลยทีเดียวครับ ช่วยชี้แนะด้วยครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub MarkGraph()
'สร้างกราฟ
    With Sheets("Sheet1")
        .Range("A1").CurrentRegion.Activate
        .Shapes.AddChart.Select
        With ActiveChart
            .ChartType = xlLine
            .SetSourceData Range("a1").CurrentRegion, PlotBy:=xlColumns
        End With
    End With
End Sub

[monstersoza]

ผมสามารถนำไปใช้ได้จริงๆเเล้วครับ ได้ผลดีมากต่อธุรกิจครับ จะพยายามศึกษาต่อไปนะครับ ขอบคุณมากๆครับ