: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

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 a reply


This question is a means of preventing automated form submissions by spambots.
Smilies
:D :thup: :cp: :flw: :rz: :sg: :tt: :) ;) :( :o :shock: :? 8-) :lol: :x :P :oops: :cry: :evil: :twisted: :roll: :!: :?: :idea: :arrow: :ard: :arl: :aru: :| :mrgreen: :geek: :ugeek:
BBCode is ON
[img] is ON
[url] is ON
Smilies are ON
Topic review
   

Expand view Topic review: รบกวนช่วยดู code

Re: รบกวนช่วยดู code

#28

by rich37 » Mon Feb 13, 2017 3:50 pm

ปัญหาแก้ไขได้แล้ว เล่นเอาเหนื่อย ขอบคุณอาจารย์ที่แนะนำครับ

Re: รบกวนช่วยดู code

#27

by rich37 » Mon Feb 13, 2017 1:14 pm

มีปัญหาใหม่เกิดขึ้นครับจาก Code ด้านล่าง เริ่มต้นจากถ้าข้อมูลในชีต Data ไม่มีข้อมูลแล้วกดส่งข้มูล สูตรที่สร้างไว้ในชีตจะถูกลบไปทั้งหมดผมเลยใส่ Msgbox ( If Worksheets("Data").Range("A3") = "" Then
MsgBox "คุณไม่มีข้อมูลที่จะส่งไป กรุณากรอกข้อมูลก่อน", vbExclamation, "กรุณากรอกข้อมูล"
Else )เตือนไว้ก็ใช้ได้ผล แต่พอชีต Data มีข้อมูล( ไม่เข้าเงื่อนไข ActiveSheet.Range("$A$2:$M$202").AutoFilter Field:=12, Criteria1:="ครบกำหนด" ) ก็เกิด error ตามรูปแนบ พาสปลดล็อค 123456789 ครับ

Code: Select all

Private Sub CommandButton1_Click()
        If Worksheets("Data").Range("A3") = "" Then
            MsgBox "คุณไม่มีข้อมูลที่จะส่งไป กรุณากรอกข้อมูลก่อน", vbExclamation, "กรุณากรอกข้อมูล"
        Else
        ActiveSheet.Unprotect  
        Selection.AutoFilter       
        ActiveSheet.Range("$A$2:$M$202").AutoFilter Field:=12, Criteria1:="ครบกำหนด"
        Sheets("Data").Range("Source").Copy Sheets("Report").Range("Target")
        Range("Source").ClearContents           
        ActiveSheet.Range("$A$2:$M$202").AutoFilter Field:=12
        Sheets("Data").Range("Source").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  
        ActiveWorkbook.Save       
        Application.DisplayAlerts = False
        Application.Quit         
        End If
End Sub
Attachments
Untitled.png
Untitled.png (3.17 KiB) Viewed 97 times
ครบนัด.xlsm
(97.12 KiB) Downloaded 9 times

Re: รบกวนช่วยดู code

#26

by snasui » Mon Feb 13, 2017 11:37 am

:D ต้องปรับมาเองก่อน ติดแล้วค่อยถามกันต่อครับ

Re: รบกวนช่วยดู code

#25

by rich37 » Mon Feb 13, 2017 11:18 am

Code: Select all

Sub Msgbox_show()
    Dim rall As Range
    For Each r In Range("L3:L203")
        If r.Value = "ครบกำหนด" Then
            MsgBox r.Address(0, 0) & " ครบกำหนดแล้ว"
        End If
    Next r
End Subb
Code ด้านบนจะวนไปจนกว่าจะครบตามเงื่อนไข ถ้าต้องการจะให้โชว์ Msgbox แค่ครั้งเดียวไม่ว่าจะมีกี่เซลส์ก็ตามที่ครบกำหนดได้หรือไม่ครับ

Re: รบกวนช่วยดู code

#24

by rich37 » Mon Feb 13, 2017 10:21 am

snasui wrote::D แสดงเมื่อเปิดไฟล์ต้องเรียกใช้จาก Event Open ครับ ตัวอย่าง http://www.excel-easy.com/vba/events.html
ขอบคุณมากๆครับอาจารย์ ตรงตามความต้องการทุกอย่างแล้วครับ

Re: รบกวนช่วยดู code

#23

by snasui » Mon Feb 13, 2017 10:15 am

:D แสดงเมื่อเปิดไฟล์ต้องเรียกใช้จาก Event Open ครับ ตัวอย่าง http://www.excel-easy.com/vba/events.html

Re: รบกวนช่วยดู code

#22

by rich37 » Mon Feb 13, 2017 10:10 am

snasui wrote::D ตัวอย่างการ Loop เพื่อแสดงผลว่าเซลล์ใดครบกำหนด ลองนำไปปรับใช้ดูครับ

Code: Select all

Sub Msgbox_show()
    Dim rall As Range
    For Each r In Range("L3:L203")
        If r.Value = "ครบกำหนด" Then
            MsgBox r.Address(0, 0) & " ครบกำหนดแล้ว"
        End If
    Next r
End Subb
ใช้ได้ครับ แต่จะให้แสดงเมื่อเปิดไฟล์ ครบนัด ได้อย่างไรครับ เมื่อเงื่อนไขเป็นจริง รบกวนด้วยครับ

Re: รบกวนช่วยดู code

#21

by snasui » Mon Feb 13, 2017 10:03 am

:D ตัวอย่างการ Loop เพื่อแสดงผลว่าเซลล์ใดครบกำหนด ลองนำไปปรับใช้ดูครับ

Code: Select all

Sub Msgbox_show()
    Dim rall As Range
    For Each r In Range("L3:L203")
        If r.Value = "ครบกำหนด" Then
            MsgBox r.Address(0, 0) & " ครบกำหนดแล้ว"
        End If
    Next r
End Subb

Re: รบกวนช่วยดู code

#20

by rich37 » Mon Feb 13, 2017 9:54 am

snasui wrote::D ใส่มาให้เรียบร้อยแล้วแนบไฟล์มาใหม่ ทำตัวอย่างข้อมูลมาด้วยว่าข้อมูลจะมีลักษณะเป็นอย่างไร และหากข้อมูลเป็นเช่นนั้น ผลของ Code นั้นจะแสดงผลอย่างไร จะได้สะดวกในการทำความเข้าใจครับ
ผมเอาใส่ใน Module แล้วรันเกิด error ตามรูปประกอบครับ ข้อมูลจะมีลักษณะดังชีตData ครับ และหากข้อมูลในเซลส์ L3 ถึง L203 มีคำว่า "ครบกำหนด" โดยข้อมูลจะอ้างจากเซลส์ K3 ถึง K203 สูตรที่ L3 =IF(ISBLANK(K3),"",IF(K3<TODAY(),"เกินกำหนด",IF(K3<=TODAY(),"ครบกำหนด","ยังไม่ถึงกำหนด")))ก็ให้ Code ทำงาน แสดง Msgbox "ครบกำหนดแล้ว" ครับ
Attachments
Untitled.png
Untitled.png (76.72 KiB) Viewed 248 times
ครบนัด (1) (1).xlsm
(94.33 KiB) Downloaded 16 times

Re: รบกวนช่วยดู code

#19

by snasui » Mon Feb 13, 2017 9:41 am

:D ใส่มาให้เรียบร้อยแล้วแนบไฟล์มาใหม่ ทำตัวอย่างข้อมูลมาด้วยว่าข้อมูลจะมีลักษณะเป็นอย่างไร และหากข้อมูลเป็นเช่นนั้น ผลของ Code นั้นจะแสดงผลอย่างไร จะได้สะดวกในการทำความเข้าใจครับ

Re: รบกวนช่วยดู code

#18

by snasui » Mon Feb 13, 2017 9:35 am

:D ที่โพสต์ไปนั้นเป็นคำถาม กรุณาอ่านใหม่ช้า ๆ และตอบมาตามที่ถามครับ

Re: รบกวนช่วยดู code

#17

by rich37 » Mon Feb 13, 2017 9:34 am

snasui wrote:
rich37 wrote:
snasui wrote::D ตัวอย่างการปรับ Code ครับ
ขอบคุณครับ ใช้งานได้แล้ว :D
มีอีก 1 เรื่องที่ลองทำแล้วยังไม่สำเร็จ คือ การให้ Msgbox แสดงในเงื่อนไขที่ว่า หากชีต Data เซลส์ L3:L203 มีคำว่า "ครบกำหนด" ( จะไม่ขึ้นทั้งหมด ตามนี้ L3 =IF(ISBLANK(K3),"",IF(K3<TODAY(),"เกินกำหนด",IF(K3<=TODAY(),"ครบกำหนด","ยังไม่ถึงกำหนด"))) )รบกวนช่วยเรื่องนี้ด้วยครับ

Code: Select all

Sub Msgbox_show()
    If Range("L3:L203").Value = "ครบกำหนด" Then
    MsgBox "ครบกำหนดแล้ว"
    End If
End Sub
:D Code ด้านบนนี้อยู่ใน Module ใดของไฟล์ที่แนบมาล่าสุดครับ :?:
ยังไม่ได้เอาใส่ไปใน Module ครับผมแค่ทดสอบรันดูมันไม่ได้ครับ
Attachments
Untitled.png
Untitled.png (76.72 KiB) Viewed 253 times

Re: รบกวนช่วยดู code

#16

by snasui » Mon Feb 13, 2017 9:30 am

rich37 wrote:
snasui wrote::D ตัวอย่างการปรับ Code ครับ
ขอบคุณครับ ใช้งานได้แล้ว :D
มีอีก 1 เรื่องที่ลองทำแล้วยังไม่สำเร็จ คือ การให้ Msgbox แสดงในเงื่อนไขที่ว่า หากชีต Data เซลส์ L3:L203 มีคำว่า "ครบกำหนด" ( จะไม่ขึ้นทั้งหมด ตามนี้ L3 =IF(ISBLANK(K3),"",IF(K3<TODAY(),"เกินกำหนด",IF(K3<=TODAY(),"ครบกำหนด","ยังไม่ถึงกำหนด"))) )รบกวนช่วยเรื่องนี้ด้วยครับ

Code: Select all

Sub Msgbox_show()
    If Range("L3:L203").Value = "ครบกำหนด" Then
    MsgBox "ครบกำหนดแล้ว"
    End If
End Sub
:D Code ด้านบนนี้อยู่ใน Module ใดของไฟล์ที่แนบมาล่าสุดครับ :?:

Re: รบกวนช่วยดู code

#15

by rich37 » Mon Feb 13, 2017 9:25 am

snasui wrote::D การตรวจสอบคำว่า "ครบกำหนด" ตรวจทุกเซลล์หรือเพียงเซลล์ใดเซลล์หนึ่งครับ

ควรแนบไฟล์ประกอบคำถามทุกครั้งเพื่อความสะดวกในการตอบของเพื่อนสมาชิกครับ
ตั้งแต่เซลส์ L3 ถึง L203 ครับว่าเซลส์ใด มีคำว่า "ครบกำหนด" ซึ่งจำนวนจะไม่แน่นอนว่ามีกี่เซลส์ ( มาจากวันที่ในเซลส์ K ครับ )
Attachments
ครบนัด (1) (1).xlsm
(103.15 KiB) Downloaded 13 times

Re: รบกวนช่วยดู code

#14

by snasui » Mon Feb 13, 2017 9:19 am

:D การตรวจสอบคำว่า "ครบกำหนด" ตรวจทุกเซลล์หรือเพียงเซลล์ใดเซลล์หนึ่งครับ

ควรแนบไฟล์ประกอบคำถามทุกครั้งเพื่อความสะดวกในการตอบของเพื่อนสมาชิกครับ

Re: รบกวนช่วยดู code

#13

by rich37 » Mon Feb 13, 2017 9:05 am

snasui wrote::D ตัวอย่างการปรับ Code ครับ
ขอบคุณครับ ใช้งานได้แล้ว :D
มีอีก 1 เรื่องที่ลองทำแล้วยังไม่สำเร็จ คือ การให้ Msgbox แสดงในเงื่อนไขที่ว่า หากชีต Data เซลส์ L3:L203 มีคำว่า "ครบกำหนด" ( จะไม่ขึ้นทั้งหมด ตามนี้ L3 =IF(ISBLANK(K3),"",IF(K3<TODAY(),"เกินกำหนด",IF(K3<=TODAY(),"ครบกำหนด","ยังไม่ถึงกำหนด"))) )รบกวนช่วยเรื่องนี้ด้วยครับ

Code: Select all

Sub Msgbox_show()
    If Range("L3:L203").Value = "ครบกำหนด" Then
    MsgBox "ครบกำหนดแล้ว"
    End If
End Sub

Re: รบกวนช่วยดู code

#12

by snasui » Mon Feb 13, 2017 6:02 am

:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim iname As String
    Application.ScreenUpdating = False
    iname = TextBox1
    Sheets("BBBack").Visible = True
    Sheets("BBBack").Select
    With [a65535].Offset.End(xlUp)
        .Offset(1, 0) = iname
    End With
    If Trim(TextBox1.Value) = "" Then
        TextBox1.SetFocus
        Sheets("BBBack").Visible = xlSheetVeryHidden
        MsgBox "ใส่ชื่อและนามสกุลก่อน"
        Exit Sub
    End If
    Sheets("BBBack").Visible = xlSheetVeryHidden
    ActiveWorkbook.Save
    Unload Me
End Sub

Re: รบกวนช่วยดู code

#11

by rich37 » Sun Feb 12, 2017 11:43 pm

snasui wrote::D สั่งให้ซ่อนแบบ VeryHidden ใหม่ครับ ตัวอย่างครับ http://stackoverflow.com/questions/8532 ... t-with-vba
ใส่ Code นี้เข้าไป ชีต Check Date กลับถูกซ่อนไปไม่รู้ว่าใส่ผิดตรงไหนอีกแล้วครับ

Code: Select all

Private Sub CommandButton1_Click()
        Application.ScreenUpdating = False
Dim iname As String
        iname = TextBox1
        Sheets("BBBack").Visible = True
    Sheets("BBBack").Select
With [a65535].Offset.End(xlUp)
.Offset(1, 0) = iname
End With
Sheets("BBBack").Visible = False
If Trim(TextBox1.Value) = "" Then
    TextBox1.SetFocus
    ActiveWindow.SelectedSheets.Visible = False
    MsgBox "ใส่ชื่อและนามสกุลก่อน"
    Exit Sub
End If
TextBox1.Value = ""
TextBox1.SetFocus
ActiveWindow.SelectedSheets.Visible = False
Sheets("BBBack").Visible = xlSheetVeryHidden
ActiveWorkbook.Save
Unload Me
End Sub

Re: รบกวนช่วยดู code

#10

by snasui » Sun Feb 12, 2017 10:28 pm

:D สั่งให้ซ่อนแบบ VeryHidden ใหม่ครับ ตัวอย่างครับ http://stackoverflow.com/questions/8532 ... t-with-vba

Re: รบกวนช่วยดู code

#9

by rich37 » Sun Feb 12, 2017 9:55 pm

puriwutpokin wrote:ใส่

Code: Select all

Sheets("BBBack").Visible = False
หลัง

Code: Select all

End With
ดูว่าใช่ไหมครับ
ขอบคุณครับ จะเอาไปลองดูครับ
snasui wrote::D Code ที่ผมโพสต์ตอบไปคือใส่เพิ่มเข้าไป ไม่ได้ให้ย้ายบรรทัดหรือลบ Code ที่มีอยู่เดิมทิ้งไปครับ

เดิมมี Code ActiveWindow.SelectedSheets.Visible = False อยู่ใต้บรรทัด TextBox1.SetForcus ก็ให้เก็บไว้เช่นเดิมครับ
ขอบคุณครับ ลองทำแล้วได้เลยครับแต่ชีทที่ใช้คำสั่ง xlsheetVeryHidden หลังจากรัน Code มันกลายเป็น xlsheetVisible ครับ จะแก้แบบไหนครับ

Top