: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

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

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ 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
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#1

Post 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
Attachments
001.jpg
001.jpg (22.28 KiB) Viewed 292 times
002.jpg
002.jpg (45.94 KiB) Viewed 292 times
save and copy to new sheets.xlsm
(27.92 KiB) Downloaded 12 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#2

Post by snasui »

:D กรอกข้อมูลด้วยมือและแสดงค่าที่ถูกต้องของชีตและเซลล์ปลายทางมาด้วยจะได้เข้าใจตรงกันครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#3

Post by Xengsue »

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

รบกวนอาจารย์ ช่วยด้วยครับ
Attachments
001.jpg
001.jpg (232.84 KiB) Viewed 298 times
save and copy to new sheets.xlsm
(27.95 KiB) Downloaded 9 times
002.jpg
002.jpg (256.37 KiB) Viewed 282 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#4

Post 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
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#5

Post 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 ได้ไหมครับ เหมือนที่เราป้อนเวลาไม่ตรงหรือยังไม่ได้ป้อนเวลาลงไปแล้ว มันจะให้เราป้อนเวลาใหม่ ครับ)
Attachments
001.jpg
001.jpg (106.41 KiB) Viewed 274 times
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#6

Post 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
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#7

Post 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 มันหมายความว่ายังไงครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#8

Post by Xengsue »

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

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

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

ขอรบกวน อาจารย์ ช่วยดูให้หน่อยว่ายังติดตรงไหนอยู่ ครับ
Attachments
save and copy to new sheets.xlsm
(29.86 KiB) Downloaded 11 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#9

Post 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 นั่นเอง
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#10

Post by snasui »

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

แต่หากเป็นคำถามใหม่ที่จะถามต่อเนื่องกันไป จะต้องปรับปรุง Code เพื่องานนั้น ๆ เสียก่อน ติดแล้วค่อยถามกันครับครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#11

Post by Xengsue »

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

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

ขอโทษที ครับ
คือ ผมลองปรับค่า -1 ของค่า i ให้เป็น 0 และ เป็น +1 เพื่อ test ดูว่ามันเป็นค่าของอาไร แต่พอผมรู้แล้วผมก็เลยลืมเปลี่ยนให้ครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#12

Post 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
Attachments
0001.jpg
0001.jpg (263.73 KiB) Viewed 239 times
save and copy to new sheets.xlsm
(28.83 KiB) Downloaded 13 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#13

Post 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
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#14

Post 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
Attachments
001.jpg
001.jpg (208.57 KiB) Viewed 232 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#15

Post 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
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#16

Post by Xengsue »

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

ส่วนเลข 15 ใน Code ที่ถามก็คือ
ปกติผมก็ใช้ในแบบเดียวกันแต่ในการปัดเศษตัวเลขตามจำนวนหลักที่กำหนดผมกำนดเอาเพียง 3 ตัวเท่านั้น แต่ทำไม อาจารย์ ถึงต้องใส่ถึง 15 เลยครับ เพราะอาไรถึงต้องใส่ 15 ครับ มีจุดประสงคอาไรหรือเปล่าครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#17

Post by Xengsue »

ขอถามเพี่มเติม ครับ
คือว่าปัญหาที่ มัน error จาก code เมื่อกี้ มัน error ได้ยังไง ดูสูตรก็ถูกแล้ว run ก็ผ่านไปหลายตัวแล้ว แต่ทำไมมันถึง error ที่ตัวเดียวนั่น ครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#18

Post by snasui »

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

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

เรื่องตัวเลขวันที่และเวลามีความซับซ้อนสูง จะต้องผ่านประสบการณ์ในการแก้ไขปัญหา มีการเรียนรู้กันพอสมควรจึงจะสามารถเลือกหนทางที่เหมาะกับข้อมูลที่กำลังทำงานได้ครับ
Top
Xengsue
Member
Member
Posts: 84
Joined: Fri Jun 23, 2017 7:57 pm

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

#19

Post by Xengsue »

snasui wrote:คำว่า "อาไร" ต้องเขียนว่า "อะไร" ไม่เช่นนั้นผิดกฎการใช้บอร์ดข้อ 1 ด้านบน
ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ

snasui wrote:แสดงว่าการกำหนดลักษณะนั้นยังเกิดความแตกต่างกันระหว่างค่าที่คีย์ลงไปเองในเซลล์กับค่าที่ได้จากการคำนวณ ถ้าจำได้จะเห็นว่าชีตแรก เป็นการคีย์เข้าไปเองโดยผู้ใช้เพื่อกำหนดเวลา แต่ชีตที่เหลือเกิดจากการบวกต่อเนื่องกันไปเพื่อให้เป็นเวลาในชม.ถัด ๆ ไป และการกำหนด Format ด้วย Code ล่าสุดสามารถที่จะจัดการปัญหาความแตกต่างตรงนี้ได้
ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ขอบคุณมากฯ ครับ
ที่ช่วยอธิบายให้ผมเข้าใจและรู้จักเกี่ยวกับคำสั่งการกำหนด Format ให้มากขื้น
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#20

Post by snasui »

Xengsue wrote:ขอโทษด้วย ครับ
คือผมเป็นคนลาว แล้วไม่ค่อยเก่งหลักภาษาไทยเท่าไร ครับ ขอโทษมากฯ ครับ
คราวหน้าจะไม่ให้พลาดอีก ครับ
:D ครับผม รับทราบครับ
Xengsue wrote:ฉะนั้น อาจารย์ จึ่งต้องใช้คำสั่ง text มาแทนคำสั่ง round ใช่ไหมครับ
ถูกต้องครับ
Top
Post Reply

Return to “Excel Macro & VBA”