Page 1 of 2
ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 2:05 pm
by Xengsue
สวัสดี ครับ อาจารย์
ผมขอรบกวน อาจารย์ หน่อยครับ
คือผมเป็นคนเก็บข้อมูลหลัก แล้วผมมีไฟล์ ให้น้องน้องป้อนข้อมูลรายชั่วโมงให้ แต่ด้วยความขี้เกี้ยดน้องน้องเลย copy อย่างเดียวทำให้ข้อมูลไม่มีการอัพเดดเปลี่ยนไปจากค่าเดีมเลย
ดั่งนั้น ผมจึ่งต้องทำไฟล์ที่มีเงื่อนไขแบบนี้เพื่อป้องกันความขี้เกียดครับ
เงื่อนไขก็คือ:
ถ้าหากผมป้อนเวลาลงใน cell "B2" และข้อมูลลงใน cell "C2:D2,C5:D5" ของ sheet"Input page"
แล้วเมื่อกดปุ่ม Save แล้วให้มันตรวจสอบเงื่อนไขว่า
ค่าใน cell "B2" ของ sheet"Input page" เท่ากับ ค่าใดใน cell "B2:B25" ของ sheet"Story information page 1" และ sheet"Story information page 2"
ให้ copy cell"C2:D2" ของ sheet"Input page" ไปไว้ใน cell "C2:D25" ของ sheet"Story information page 1"
ตามค่าของ cell "B2:B25" ของ sheet"Input page"
และ ให้ copy cell"C5:D5" ของ sheet"Input page" ไปไว้ใน cell "C2:D25" ของ sheet"Story information page 2"
ตามค่าของ cell "B2:B25" ของ sheet"Input page"
แล้วเมือเราป้อนเข้าไปในเวลาใหม่ก็ให้มัน save ไปตามเวลาที่ได้วางเอาไว้ ครับ
แต่ผมพึงเขียนได้นิดเดียวเพื่อทดสอบดูก่อนแต่มันก็ไม่ work ให้ผมเลยครับ มันจะโดดไปหา เงื่อนไขของ Else เลย
ขอรบกวน อาจารย์ ด้วยครับ
Code: Select all
Private Sub CommandButton1_Click()
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
If Worksheets("Input page").Range("B2").Value = "00:00" Then
Worksheets("Input page").Range("C2:D2").Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("Storage information page 1").Range("C2:D2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Else
Worksheets("Storage information page 1").Range("C2:D2").Value = 0
MsgBox ("Incomplete information, Please check and save again...")
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ActiveWorkbook.Save
End Sub
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 2:15 pm
by snasui

กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 3:44 pm
by Xengsue
snasui wrote:
กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ
คือผมต้องการดั่งที่ผมอธิบายอยู่ในรูป ครับ อาจารย์
รบกวนอาจารย์ ช่วยด้วยครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 5:03 pm
by snasui

ตัวอย่าการปรับ Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ActiveWorkbook.Save
End Sub
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 6:06 pm
by Xengsue
snasui wrote:
ตัวอย่าการปรับ Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ActiveWorkbook.Save
End Sub
ขอบคุณมาก ครับ อาจารย์
ใช้ได้ตามที่ต้องการ ครับ
แต่ว่ายังมีปัญหาอยู่ที่ว่า
1.ถ้าเราป้อนข้อมูลหมดแล้วเหลือแค่ยังไม่ได้ป้อนเวลาลงไปแล้วเราไปกดปุ่ม save เลย มันก็จะไปเขียนทับข้อมูลที่เซลล์ปลายทางเลย ครับ
(ข้อนี้คืออยากให้เงื่อนไขตัวนี้ไปจัดเข้ากับเงื่อนไขของ Else ได้ไหมครับ เหมือนที่เราป้อนเวลาไม่ตรงหรือยังไม่ได้ป้อนเวลาลงไปแล้ว มันจะให้เราป้อนเวลาใหม่ ครับ)
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Tue Oct 24, 2017 7:24 pm
by Xengsue
Xengsue wrote:snasui wrote:
ตัวอย่าการปรับ Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ActiveWorkbook.Save
End Sub
ขอบคุณมาก ครับ อาจารย์
ใช้ได้ตามที่ต้องการ ครับ
แต่ว่ายังมีปัญหาอยู่ที่ว่า
1.ถ้าเราป้อนข้อมูลหมดแล้วเหลือแค่ยังไม่ได้ป้อนเวลาลงไปแล้วเราไปกดปุ่ม save เลย มันก็จะไปเขียนทับข้อมูลที่เซลล์ปลายทางเลย ครับ
(ข้อนี้คืออยากให้เงื่อนไขตัวนี้ไปจัดเข้ากับเงื่อนไขของ Else ได้ไหมครับ เหมือนที่เราป้อนเวลาไม่ตรงหรือยังไม่ได้ป้อนเวลาลงไปแล้ว มันจะให้เราป้อนเวลาใหม่ ครับ)
ขอบคุณมาก ครับ อาจารย์
คือตอนนี้ได้ตามต้องการแล้วนะ ครับ
คือผมเสรีม code ตัวนี้เข้าไป
Code: Select all
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
Code: Select all
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
ThisWorkbook.Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ThisWorkbook.Protect Password:="1"
ActiveWorkbook.Save
End Sub
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Wed Oct 25, 2017 4:23 am
by Xengsue
อาจารย์ ครับ รบกวนขอให้อาจารย์ช่วยให้คำอธิบายเกี่ยวกับ 2 ตัวนี้ให้ด้วยครับ
Code: Select all
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ค่า -1 คือค่าอะไร มันมีความหมายถึงอะไร ครับ
Code: Select all
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
Resize(1, 2).Value มันหมายความว่ายังไงครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Wed Oct 25, 2017 4:40 pm
by Xengsue
สวัสดี ครับ อาจารย์
อยากมาขอรบกวนอีก ครั้งด้วย
คือว่าผมไม่ได้ run เช็คดูทุกชั่วโมง แล้วตอนนี้ให้น้องน้องเขาป้อนข้อมูลเข้าไป แล้วมันไม่สามารถป้อนได้ทุกรายชั่วโมง ครับ
มันจะเข้าเงื่อนไขของ else หมดเลย
คือชั่วโมงที่สามารถป้อนได้มี 00:00 - 04:00 น. และ 08:00 - 10:00 น. และ 12:00 - 13:00 น.
ส่วนชั่วโมงอื่นมันตกในอยู่ในเงื่อนไขของ else กันหมดต้องให้ตรวจเช็คเวลาคืนใหม่ทั้งที่เราก็ป้อนถูกต้องอยู่แล้ว
คืออยากให้สามารถป้อนเข้าได้ทุกชั่วโมง ครับ
ขอรบกวน อาจารย์ ช่วยดูให้หน่อยว่ายังติดตรงไหนอยู่ ครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Wed Oct 25, 2017 11:37 pm
by snasui
Xengsue wrote:อาจารย์ ครับ รบกวนขอให้อาจารย์ช่วยให้คำอธิบายเกี่ยวกับ 2 ตัวนี้ให้ด้วยครับ
Code: Select all
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
ค่า -1 คือค่าอะไร มันมีความหมายถึงอะไร ครับ
Code: Select all
With Sheets("Storage information page 1")
.Range("c2").Offset(i, 0).Resize(1, 2).Value = rng1.Value
End With
Resize(1, 2).Value มันหมายความว่ายังไงครับ

จาก Code นี้
Code: Select all
If Not IsError(Application.Match(timeInput.Value, timeRng, 0)) Then
i = Application.Match(timeInput.Value, timeRng, 0) - 1
หมายถึง หากทำการ Match ค่าของ timeInput.value ในช่วงข้อมูล timeRng แล้วไม่เป็นค่าผิดพลาด จะกำหนดค่าให้กับตัวแปร i เป็นลำดับที่พบค่า timeInput.Value ในช่วง timeRng โดยจะต้องลบลำดับที่พบออกด้วย 1 เพื่อจะได้ตำค่านี้ไปใช้ต่อไป
จาก
Resize(1, 2) แปลว่าให้ขยายข้อมูลเป็น 1 บรรทัดและ 2 คอลัมน์ ส่วน
.Value เป็น Property ของข้อมูล หมายถึง ค่าของข้อมูลนั้น เช่น
Range("A1").Value คือค่าของ A1 นั่นเอง
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Wed Oct 25, 2017 11:49 pm
by snasui

Code ที่เขียนมากำหนดค่า i ไม่ตรงกับที่ผมแจ้งไป ขอให้ใช้ตามที่ผมแนะนำไปทุกอักขระเสียก่อนแล้วค่อยแจ้งสิ่งที่ผิดพลาด ช่วยทดสอบด้วย Code ที่ผมแจ้งไปอีกรอบ หากยังไม่ตรงให้แนบไฟล์มาใหม่ ระบุเวลาที่ผิดพลาดมาสัก 2-3 ค่าจะได้สะดวกในการทดสอบ โดย Code ในไฟล์ที่แนบมานั้นจะต้องเป็นไปตามที่ผมปรับปรุงไปล่าสุดแล้วยังเป็นปัญหา
แต่หากเป็นคำถามใหม่ที่จะถามต่อเนื่องกันไป จะต้องปรับปรุง Code เพื่องานนั้น ๆ เสียก่อน ติดแล้วค่อยถามกันครับครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 2:38 am
by Xengsue
snasui wrote:
Code ที่เขียนมากำหนดค่า i ไม่ตรงกับที่ผมแจ้งไป ขอให้ใช้ตามที่ผมแนะนำไปทุกอักขระเสียก่อนแล้วค่อยแจ้งสิ่งที่ผิดพลาด ช่วยทดสอบด้วย Code ที่ผมแจ้งไปอีกรอบ หากยังไม่ตรงให้แนบไฟล์มาใหม่ ระบุเวลาที่ผิดพลาดมาสัก 2-3 ค่าจะได้สะดวกในการทดสอบ โดย Code ในไฟล์ที่แนบมานั้นจะต้องเป็นไปตามที่ผมปรับปรุงไปล่าสุดแล้วยังเป็นปัญหา
แต่หากเป็นคำถามใหม่ที่จะถามต่อเนื่องกันไป จะต้องปรับปรุง Code เพื่องานนั้น ๆ เสียก่อน ติดแล้วค่อยถามกันครับครับ
ขอโทษที ครับ
คือ ผมลองปรับค่า -1 ของค่า i ให้เป็น 0 และ เป็น +1 เพื่อ test ดูว่ามันเป็นค่าของอาไร แต่พอผมรู้แล้วผมก็เลยลืมเปลี่ยนให้ครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 3:32 am
by Xengsue
จาก code ที่อาจารย์ให้มา ผมทดลองดูแล้วเจอ 2 ปัญหา
1. ถ้าเราไม่ได้ป้อนเวลาแล้วเรากดปุ่ม save มันจะไปเขียนทับข้อมูลของตำแหน่งเวลา 00:00 น. เลยครับ
2. แล้วหลังจากเราป้อนข้อมูลเป็นรายชั่วโมงต่อเนื่องกันไปก็ปกติ แต่พอถึงเวลา 05:00 น. เวลาเรากดปุ่ม save มันจะฟ้องขึ้นว่าให้เราเช็คดูเวลาที่ป้อนเข้าใหม่ครับ แล้วยังมีช่วงเวลา 6-7, 11, 14-23 ก็เป็นเหมือนกันครับ
ดั่งในรูปที่ 1
หลังจากผมเพี่ม code เข้าไปนิดหนึ่ง ปัญหาที่ 1 ที่เจอก็ผ่าน ครับ แต่ยังติดที่ ปัญหาที่ 2 ที่ยังแก้ไม่หายครับ
นการแก้ปัญหาข้อที่ 2 นี้ผมต้องการให้ป้อนข้อมูล และ save ผ่านทุกชั่วโมง ยกเว็นแต่ถ้าเราไม่ได้ป้อนเวลาลงไป หรือ ว่าป้อนเวลาไม่ตรงก็ให้มันแจ้งให้เราตรวจเช็คดูเวลาคืนใหม่แต่จะไม่สามารถ save จนกว่าจะผ่าน แล้วค่อย save
code ที่ผมเพี่มเข้าไป
Code: Select all
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
End If
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 7:06 am
by snasui

ตัวอย่างการปรับ Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range, rng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
If Application.CountIf(timeRng, timeInput.Value) Then
For Each rng In timeRng
If Round(rng.Value, 15) = Round(timeInput.Value, 15) Then
i = rng.Row
Exit For
End If
Next rng
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
ThisWorkbook.Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c" & i).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c" & i).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ThisWorkbook.Protect Password:="1"
ActiveWorkbook.Save
End Sub
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 12:23 pm
by Xengsue
snasui wrote:
ตัวอย่างการปรับ Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim i As Integer, timeRng As Range, rng As Range
Dim timeInput As Range, rng1 As Range, rng2 As Range
With Sheets("Storage information page 1")
Set timeRng = .Range("b2:b25")
End With
With Sheets("Input page")
Set timeInput = .Range("b2")
Set rng1 = .Range("c2:d2")
Set rng2 = .Range("c5:d5")
End With
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
If Application.CountIf(timeRng, timeInput.Value) Then
For Each rng In timeRng
If Round(rng.Value, 15) = Round(timeInput.Value, 15) Then
i = rng.Row
Exit For
End If
Next rng
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
ThisWorkbook.Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c" & i).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c" & i).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
End If
ThisWorkbook.Worksheets("Input page").Range("B2:D2").ClearContents
ThisWorkbook.Worksheets("Input page").Range("C5:D5").ClearContents
ThisWorkbook.Worksheets("Storage information page 1").Protect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Protect Password:="1"
ThisWorkbook.Protect Password:="1"
ActiveWorkbook.Save
End Sub
จาก code ตัวนี้ผมลอง test ดูแล้วเจออยู่ 2 ปัญหา
ปัญหาที่ 1.คือเมื่อ run ชั่วโมงที่ 16:00 น. มันจะ Error พอผมกด debug ดูก็เจอบรรทัดดั่งรูปที่มีสีเหลือง ครับ
ปัญหาที่ 2. ชั่วโมงที่ 19:00 น. กับชั่วโมงที่ 22:00 น. ยังเหมือนเดิมยังแก้ไม่หายจากปัญหาที่เจอผ่านมาครับ
และ code ที่อาจารย์ให้มาผมไม่เข้าใจบรรทัดนี้ครับ ปกติผมใช้ในการปัดเศษตัวเลขตามจำนวนหลักที่กำหนด แต่ทำไม อาจารย์ ถึงต้องใส่ 15 ลงไปครับ
Code: Select all
If Round(rng.Value, 15) = Round(timeInput.Value, 15) Then
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:01 pm
by snasui

ตัวอย่างการปรับ Code ครับ
เลข 15 ใน Code ที่ถามมาคือจำนวนหลักในการปัด ปกติกำหนดหลักในการปัดด้วยวิธีใดจึงเกิดความสงสัยในตัวเลข 15 นี้ครับ
Code: Select all
'Other code
If timeInput.Value = "" Then
MsgBox "Please check your input time.", vbInformation
Exit Sub
Else
For Each rng In timeRng
If Application.Text(rng.Value, "h:mm") = Application.Text(timeInput.Value, "h:mm") Then
i = rng.Row
Exit For
End If
Next rng
If i > 0 Then
ThisWorkbook.Worksheets("Storage information page 1").Unprotect Password:="1"
ThisWorkbook.Worksheets("Storage information page 2").Unprotect Password:="1"
ThisWorkbook.Unprotect Password:="1"
With Sheets("Storage information page 1")
.Range("c" & i).Resize(1, 2).Value = rng1.Value
End With
With Sheets("Storage information page 2")
.Range("c" & i).Resize(1, 2).Value = rng2.Value
End With
Else
MsgBox "Please check your input time.", vbInformation
Exit Sub
End If
End If
'Other code
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:20 pm
by Xengsue
ขอบคุณ ครับ อาจารย์
ตอนนี้ผ่าน ตามต้องการแล้ว ครับ
ส่วนเลข 15 ใน Code ที่ถามก็คือ
ปกติผมก็ใช้ในแบบเดียวกันแต่ในการปัดเศษตัวเลขตามจำนวนหลักที่กำหนดผมกำนดเอาเพียง 3 ตัวเท่านั้น แต่ทำไม อาจารย์ ถึงต้องใส่ถึง 15 เลยครับ เพราะอาไรถึงต้องใส่ 15 ครับ มีจุดประสงคอาไรหรือเปล่าครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:26 pm
by Xengsue
ขอถามเพี่มเติม ครับ
คือว่าปัญหาที่ มัน error จาก code เมื่อกี้ มัน error ได้ยังไง ดูสูตรก็ถูกแล้ว run ก็ผ่านไปหลายตัวแล้ว แต่ทำไมมันถึง error ที่ตัวเดียวนั่น ครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:34 pm
by snasui
Xengsue wrote:เพราะอาไรถึงต้องใส่ 15 ครับ
คำว่า "อาไร" ต้องเขียนว่า "อะไร" ไม่เช่นนั้นผิดกฎการใช้บอร์ดข้อ 1 ด้านบน
การใส่เลข 15 เพื่อให้เป็นการปัดที่หลักมาก ๆ จะได้เพิ่มความแม่นยำ ประเด็นหลักมีเท่านี้ครับ
Xengsue wrote:ปัญหาที่ มัน error จาก code เมื่อกี้ มัน error ได้ยังไง ดูสูตรก็ถูกแล้ว run ก็ผ่านไปหลายตัวแล้ว แต่ทำไมมันถึง error ที่ตัวเดียวนั่น
แสดงว่าการกำหนดลักษณะนั้นยังเกิดความแตกต่างกันระหว่างค่าที่คีย์ลงไปเองในเซลล์กับค่าที่ได้จากการคำนวณ ถ้าจำได้จะเห็นว่าชีตแรก เป็นการคีย์เข้าไปเองโดยผู้ใช้เพื่อกำหนดเวลา แต่ชีตที่เหลือเกิดจากการบวกต่อเนื่องกันไปเพื่อให้เป็นเวลาในชม.ถัด ๆ ไป และการกำหนด Format ด้วย Code ล่าสุดสามารถที่จะจัดการปัญหาความแตกต่างตรงนี้ได้
เรื่องตัวเลขวันที่และเวลามีความซับซ้อนสูง จะต้องผ่านประสบการณ์ในการแก้ไขปัญหา มีการเรียนรู้กันพอสมควรจึงจะสามารถเลือกหนทางที่เหมาะกับข้อมูลที่กำลังทำงานได้ครับ
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:50 pm
by Xengsue
snasui wrote:คำว่า "อาไร" ต้องเขียนว่า "อะไร" ไม่เช่นนั้นผิดกฎการใช้บอร์ดข้อ 1 ด้านบน
ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ
snasui wrote:แสดงว่าการกำหนดลักษณะนั้นยังเกิดความแตกต่างกันระหว่างค่าที่คีย์ลงไปเองในเซลล์กับค่าที่ได้จากการคำนวณ ถ้าจำได้จะเห็นว่าชีตแรก เป็นการคีย์เข้าไปเองโดยผู้ใช้เพื่อกำหนดเวลา แต่ชีตที่เหลือเกิดจากการบวกต่อเนื่องกันไปเพื่อให้เป็นเวลาในชม.ถัด ๆ ไป และการกำหนด Format ด้วย Code ล่าสุดสามารถที่จะจัดการปัญหาความแตกต่างตรงนี้ได้
ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ขอบคุณมากฯ ครับ
ที่ช่วยอธิบายให้ผมเข้าใจและรู้จักเกี่ยวกับคำสั่งการกำหนด Format ให้มากขื้น
Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets
Posted: Thu Oct 26, 2017 1:55 pm
by snasui
Xengsue wrote:ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ

ครับผม รับทราบครับ
Xengsue wrote:ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ถูกต้องครับ