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

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

ฟอรั่มถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟลที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#1

Postby Xengsue » Tue Oct 24, 2017 2:05 pm

สวัสดี ครับ อาจารย์
ผมขอรบกวน อาจารย์ หน่อยครับ
คือผมเป็นคนเก็บข้อมูลหลัก แล้วผมมีไฟล์ ให้น้องน้องป้อนข้อมูลรายชั่วโมงให้ แต่ด้วยความขี้เกี้ยดน้องน้องเลย 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
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#2

Postby snasui » Tue Oct 24, 2017 2:15 pm

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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#3

Postby Xengsue » Tue Oct 24, 2017 3:44 pm

snasui wrote::D กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ


คือผมต้องการดั่งที่ผมอธิบายอยู่ในรูป ครับ อาจารย์

รบกวนอาจารย์ ช่วยด้วยครับ
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#4

Postby snasui » Tue Oct 24, 2017 5:03 pm

: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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#5

Postby Xengsue » Tue Oct 24, 2017 6:06 pm

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 ได้ไหมครับ เหมือนที่เราป้อนเวลาไม่ตรงหรือยังไม่ได้ป้อนเวลาลงไปแล้ว มันจะให้เราป้อนเวลาใหม่ ครับ)
You do not have the required permissions to view the files attached to this post.

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#6

Postby Xengsue » Tue Oct 24, 2017 7:24 pm

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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#7

Postby Xengsue » Wed Oct 25, 2017 4:23 am

อาจารย์ ครับ รบกวนขอให้อาจารย์ช่วยให้คำอธิบายเกี่ยวกับ 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 มันหมายความว่ายังไงครับ

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#8

Postby Xengsue » Wed Oct 25, 2017 4:40 pm

สวัสดี ครับ อาจารย์
อยากมาขอรบกวนอีก ครั้งด้วย
คือว่าผมไม่ได้ run เช็คดูทุกชั่วโมง แล้วตอนนี้ให้น้องน้องเขาป้อนข้อมูลเข้าไป แล้วมันไม่สามารถป้อนได้ทุกรายชั่วโมง ครับ
มันจะเข้าเงื่อนไขของ else หมดเลย
คือชั่วโมงที่สามารถป้อนได้มี 00:00 - 04:00 น. และ 08:00 - 10:00 น. และ 12:00 - 13:00 น.

ส่วนชั่วโมงอื่นมันตกในอยู่ในเงื่อนไขของ else กันหมดต้องให้ตรวจเช็คเวลาคืนใหม่ทั้งที่เราก็ป้อนถูกต้องอยู่แล้ว

คืออยากให้สามารถป้อนเข้าได้ทุกชั่วโมง ครับ

ขอรบกวน อาจารย์ ช่วยดูให้หน่อยว่ายังติดตรงไหนอยู่ ครับ
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#9

Postby snasui » Wed Oct 25, 2017 11:37 pm

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 นั่นเอง

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#10

Postby snasui » Wed Oct 25, 2017 11:49 pm

:D Code ที่เขียนมากำหนดค่า i ไม่ตรงกับที่ผมแจ้งไป ขอให้ใช้ตามที่ผมแนะนำไปทุกอักขระเสียก่อนแล้วค่อยแจ้งสิ่งที่ผิดพลาด ช่วยทดสอบด้วย Code ที่ผมแจ้งไปอีกรอบ หากยังไม่ตรงให้แนบไฟล์มาใหม่ ระบุเวลาที่ผิดพลาดมาสัก 2-3 ค่าจะได้สะดวกในการทดสอบ โดย Code ในไฟล์ที่แนบมานั้นจะต้องเป็นไปตามที่ผมปรับปรุงไปล่าสุดแล้วยังเป็นปัญหา

แต่หากเป็นคำถามใหม่ที่จะถามต่อเนื่องกันไป จะต้องปรับปรุง Code เพื่องานนั้น ๆ เสียก่อน ติดแล้วค่อยถามกันครับครับ

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#11

Postby Xengsue » Thu Oct 26, 2017 2:38 am

snasui wrote::D Code ที่เขียนมากำหนดค่า i ไม่ตรงกับที่ผมแจ้งไป ขอให้ใช้ตามที่ผมแนะนำไปทุกอักขระเสียก่อนแล้วค่อยแจ้งสิ่งที่ผิดพลาด ช่วยทดสอบด้วย Code ที่ผมแจ้งไปอีกรอบ หากยังไม่ตรงให้แนบไฟล์มาใหม่ ระบุเวลาที่ผิดพลาดมาสัก 2-3 ค่าจะได้สะดวกในการทดสอบ โดย Code ในไฟล์ที่แนบมานั้นจะต้องเป็นไปตามที่ผมปรับปรุงไปล่าสุดแล้วยังเป็นปัญหา

แต่หากเป็นคำถามใหม่ที่จะถามต่อเนื่องกันไป จะต้องปรับปรุง Code เพื่องานนั้น ๆ เสียก่อน ติดแล้วค่อยถามกันครับครับ



ขอโทษที ครับ
คือ ผมลองปรับค่า -1 ของค่า i ให้เป็น 0 และ เป็น +1 เพื่อ test ดูว่ามันเป็นค่าของอาไร แต่พอผมรู้แล้วผมก็เลยลืมเปลี่ยนให้ครับ

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#12

Postby Xengsue » Thu Oct 26, 2017 3:32 am

จาก 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
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#13

Postby snasui » Thu Oct 26, 2017 7:06 am

: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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#14

Postby Xengsue » Thu Oct 26, 2017 12:23 pm

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
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#15

Postby snasui » Thu Oct 26, 2017 1:01 pm

: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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#16

Postby Xengsue » Thu Oct 26, 2017 1:20 pm

ขอบคุณ ครับ อาจารย์
ตอนนี้ผ่าน ตามต้องการแล้ว ครับ

ส่วนเลข 15 ใน Code ที่ถามก็คือ
ปกติผมก็ใช้ในแบบเดียวกันแต่ในการปัดเศษตัวเลขตามจำนวนหลักที่กำหนดผมกำนดเอาเพียง 3 ตัวเท่านั้น แต่ทำไม อาจารย์ ถึงต้องใส่ถึง 15 เลยครับ เพราะอาไรถึงต้องใส่ 15 ครับ มีจุดประสงคอาไรหรือเปล่าครับ

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#17

Postby Xengsue » Thu Oct 26, 2017 1:26 pm

ขอถามเพี่มเติม ครับ
คือว่าปัญหาที่ มัน error จาก code เมื่อกี้ มัน error ได้ยังไง ดูสูตรก็ถูกแล้ว run ก็ผ่านไปหลายตัวแล้ว แต่ทำไมมันถึง error ที่ตัวเดียวนั่น ครับ

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#18

Postby snasui » Thu Oct 26, 2017 1:34 pm

:D
Xengsue wrote:เพราะอาไรถึงต้องใส่ 15 ครับ


คำว่า "อาไร" ต้องเขียนว่า "อะไร" ไม่เช่นนั้นผิดกฎการใช้บอร์ดข้อ 1 ด้านบน

การใส่เลข 15 เพื่อให้เป็นการปัดที่หลักมาก ๆ จะได้เพิ่มความแม่นยำ ประเด็นหลักมีเท่านี้ครับ

Xengsue wrote:ปัญหาที่ มัน error จาก code เมื่อกี้ มัน error ได้ยังไง ดูสูตรก็ถูกแล้ว run ก็ผ่านไปหลายตัวแล้ว แต่ทำไมมันถึง error ที่ตัวเดียวนั่น


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

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

Xengsue
Member
Member
Posts: 28
Joined: Fri Jun 23, 2017 7:57 pm

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

#19

Postby Xengsue » Thu Oct 26, 2017 1:50 pm

snasui wrote:คำว่า "อาไร" ต้องเขียนว่า "อะไร" ไม่เช่นนั้นผิดกฎการใช้บอร์ดข้อ 1 ด้านบน


ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ


snasui wrote:แสดงว่าการกำหนดลักษณะนั้นยังเกิดความแตกต่างกันระหว่างค่าที่คีย์ลงไปเองในเซลล์กับค่าที่ได้จากการคำนวณ ถ้าจำได้จะเห็นว่าชีตแรก เป็นการคีย์เข้าไปเองโดยผู้ใช้เพื่อกำหนดเวลา แต่ชีตที่เหลือเกิดจากการบวกต่อเนื่องกันไปเพื่อให้เป็นเวลาในชม.ถัด ๆ ไป และการกำหนด Format ด้วย Code ล่าสุดสามารถที่จะจัดการปัญหาความแตกต่างตรงนี้ได้


ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ขอบคุณมากฯ ครับ
ที่ช่วยอธิบายให้ผมเข้าใจและรู้จักเกี่ยวกับคำสั่งการกำหนด Format ให้มากขื้น

User avatar
snasui
Site Admin
Site Admin
Posts: 22372
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

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

#20

Postby snasui » Thu Oct 26, 2017 1:55 pm

Xengsue wrote:ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ


:D ครับผม รับทราบครับ

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


ถูกต้องครับ


Return to “Excel”

Who is online

Users browsing this forum: 060090, littleome, March201711, sksk, smonekai and 36 guests