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
:D กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ

Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets

Posted: Tue Oct 24, 2017 3:44 pm
by Xengsue
snasui wrote::D กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ
คือผมต้องการดั่งที่ผมอธิบายอยู่ในรูป ครับ อาจารย์

รบกวนอาจารย์ ช่วยด้วยครับ

Re: ขอคำแนะนำเกี่ยวกับ code VBA ที่ save and copy to new sheets

Posted: Tue Oct 24, 2017 5:03 pm
by snasui
:D ตัวอย่าการปรับ 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::D ตัวอย่าการปรับ 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::D ตัวอย่าการปรับ 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 มันหมายความว่ายังไงครับ
:D จาก 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
:D 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::D 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
:D ตัวอย่างการปรับ 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::D ตัวอย่างการปรับ 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
:D ตัวอย่างการปรับ 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
:D
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:ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ
:D ครับผม รับทราบครับ
Xengsue wrote:ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ถูกต้องครับ