Page 1 of 2

การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Jul 31, 2018 10:08 am
by Leng
ผมต้องการกำหนด ถ้าพิม "5555" ในช่อง Barcode ให้ลบทีละบันทัด ครับ

Code: Select all

If MsgBox(" Finish this carton ?", vbYesNo + vbQuestion + vbDefaultButton2, " Close and Save ") = 6 Then
Sheets("in").Select
Range("A3:D1048576").Select
Do While ActiveCell <> ""
ActiveCell.Offset(0, 0).EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Loop
End If

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Jul 31, 2018 8:19 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

'Other code...
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
    Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
End With
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
End With
If Me.TextBox5.Text = "" Then Exit Sub
If Me.TextBox5.Text = "5555" Then
    Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
End If
'Other code...

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Jul 31, 2018 9:52 pm
by Leng
สอบถามเพิ่มครับเวลา scan "10020" ผมต้องการให้ ขึ้น YES/NO ครับแต่ปัญหาคือ
-เวลา scan โค๊ด อื่นที่ไม่ใช่ 10020 ก็จะขึ้น Yes/No ด้วยครับ ผมไม่อยากให้ขึ้น Yes/No ครับผมต้องแก้ยังไงครับ
- เวลา scan โค๊ด 10020 ผมไม่อยากให้ขึ้น MsgBox "Not found." ครับผมต้องทำยังไงครับ

Code: Select all

Private Sub TextBox5_AfterUpdate()
If MsgBox(" Finish this carton ?", vbYesNo + vbQuestion + vbDefaultButton2, " Close and Save ") = 6 Then
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
    Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
End With
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
End With
If Me.TextBox5.Text = "" Then Exit Sub
If Me.TextBox5.Text = "10020" Then
    Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
    End If
   End If
Dim SoundFile As String, rc As Long
SoundFile = "C:\Users\Administrator\Downloads\A_Drum.wav"
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
If Me.TextBox5.Text = "" Then Exit Sub
If WorksheetFunction.CountIf(Workbooks("DataX.xlsx").Worksheets("Sheet1").Range("A:D"), Me.TextBox5.Value) = 0 Then
'Me.TextBox5.Value = ""
MsgBox "Not found."
Exit Sub
End If
    Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
    Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
    Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)
End With
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
   End With
    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Wed Aug 01, 2018 6:47 am
by logic
ต้องเขียน if ดักการแสดงบรรทัดนี้นะครับ ถ้าไม่ดักมันก็ขึ้นทุกรอบ
Leng wrote: Tue Jul 31, 2018 9:52 pm

Code: Select all

If MsgBox(" Finish this carton ?", vbYesNo + vbQuestion + vbDefaultButton2, " Close and Save ") = 6 Then
ถ้าเป็นผมจะเขียนไว้ในโค้ดนี้

Code: Select all

If Me.TextBox5.Text = "10020" Then
    Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
     If MsgBox(" Finish this carton ?", vbYesNo + vbQuestion + vbDefaultButton2, " Close and Save ") = 6 Then
     '....
     End If    
End If

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Thu Aug 02, 2018 9:20 am
by Leng
ผมได้ลองนำCode มาใส่แต่ก็ยังไม่ได้ครับ

Code: Select all

'other
If Me.TextBox5.Text = "10020" Then
    Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
     If MsgBox(" Finish this carton ?", vbYesNo + vbQuestion + vbDefaultButton2, " Close and Save ") = 6 Then
     '....
     End If
End If
'other

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Thu Aug 02, 2018 7:36 pm
by snasui
:D ผมทดสอบแล้ว Code นั้นทำงานได้ครับ คือคีย์ 10020 มันจะมีการลบบรรทัดและขึ้นข้อความมาถาม

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Fri Aug 03, 2018 8:13 am
by Leng
ได้ละครับขอบพระคุณมากครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 7:26 pm
by Leng
อาจารย์ครับตอนแรกใช้งานได้แล้วแต่พอเริ่มทำเรื่อยๆเพิ่มโค๊ดอื่นเรื่อย ทำไมเวลา scan 10021 ข้อมูลไม่ลบครับ
โค๊ดที่ error ครับ

Code: Select all

Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete

Code: Select all

Private Sub TextBox2_AfterUpdate()
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
    Set rngVlp = .Range("E2", .Range("F" & .Rows.Count))
If Me.TextBox2.Text = "" Then Exit Sub
If WorksheetFunction.CountIf(Workbooks("DataX.xlsx").Worksheets("Sheet1").Range("E:F"), Me.TextBox2.Value) = 0 Then
Call Sample2
'Me.TextBox2.Value = ""
MsgBox "Not found."
Exit Sub
End If
    Me.TextBox10 = Application.VLookup(CLng(Me.TextBox2.Text), rngVlp, 2, 0)
End With
End Sub

Private Sub TextBox5_AfterUpdate()
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
End With

With ThisWorkbook.Worksheets("IN")
emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
End With

If Me.TextBox5.Text = "10021" Then
Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
  Me.TextBox11.Text = Application.WorksheetFunction.Sum(Range("H3:H1048576"))
End If

If Me.TextBox5.Text = "" Then Exit Sub
If WorksheetFunction.CountIfs(Workbooks("DataX.xlsx").Worksheets("Sheet1").Range("A:A"), Me.TextBox5.Value, _
Workbooks("DataX.xlsx").Worksheets("Sheet1").Range("E:E"), Me.TextBox2.Value) = 0 Then
Call Sample2
'Me.TextBox5.Value = ""
MsgBox "Please Check Information"
    Exit Sub

End If
    Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
    Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
    Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)
    Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
    Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
    Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
   End With
    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = ComboBox1.Value
        .Cells(emptyrow, 4).Value = TextBox5.Value
        .Cells(emptyrow, 5).Value = TextBox6.Value
        .Cells(emptyrow, 6).Value = TextBox7.Value
        .Cells(emptyrow, 7).Value = TextBox8.Value
        .Cells(emptyrow, 8).Value = TextBox9.Value
    End With
    
    Me.TextBox11.Text = Application.WorksheetFunction.Sum(Range("H3:H1048576"))
Dim total As Long
'Me.TextBox5.Value = ""
total = WorksheetFunction.Sum(Range("H3:H1048576"))
Range("A1").Value = total
Range("C1") = TextBox10.Value
If Range("A1").Value > Range("C1") Then
Call Sample2
MsgBox "TOTAL NUMBER ERROR"
End If
        Dim lsRow As Long
    With Sheets("IN")
        lsRow = .Range("a" & .Rows.Count).End(xlUp).Row
    End With
     ListBox1.RowSource = Sheets("IN").Range("A3:H" & lsRow).Address(external:=True)
    With ListBox1
        .ListIndex = .ListCount - 1
        .Selected(.ListCount - 1) = True
    End With
End Sub

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 7:42 pm
by snasui
Leng wrote: Tue Aug 14, 2018 7:26 pm อาจารย์ครับตอนแรกใช้งานได้แล้วแต่พอเริ่มทำเรื่อยๆเพิ่มโค๊ดอื่นเรื่อย ทำไมเวลา scan 10021 ข้อมูลไม่ลบครับ
โค๊ดที่ error ครับ
:D เกิดจากการเผลอไป Protect Sheet หรือตั้งใจ Protect Sheet กรณีตั้งใจ Protect ให้ Unprotect ด้วย Code เสียก่อน เมื่อทำงานเสร็จแล้วค่อย Protect ใหม่ด้วย Code กรณีไม่ได้ตั้งใจ Protect ให้คลิกขวาที่ Sheet IN เลือก Unprotect Sheet เพื่อยกเลิกการ Protect ครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 7:53 pm
by Leng
ผมต้องแก้ไขcode ยังไง ถึงจะใช้งานได้ครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 7:56 pm
by snasui
:D ดูตัวอย่างที่นี่ครับ https://www.snasui.com/viewtopic.php?t=8621#p54040

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:06 pm
by Leng
อาจารย์ครับผมได้นำโค๊ดที่ใช้ได้ มาลองเทียบกับโค๊ดที่ใช้ไม่ได้ แต่ก็เหมือนกันเกือบหมดครับแต่ทำไมไฟล์ที่ผมส่งให้อาจารย์ถึงใช้ไม่ได้ทั้งๆที่โค๊ดก็เหมือนกับโค๊ดที่ผมใช้ได้

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:08 pm
by snasui
:D ผมตอบไปแล้วตามโพสต์ #9 :aru: กรุณาอ่านอย่างละเอียด สงสัยประโยคไหนให้ยกมาถามครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:27 pm
by Leng

Code: Select all

Dim i&
With ActiveSheet
If Me.TextBox5.Text = "10021" Then
 i = Worksheets("IN").Cells(emptyrow - 1, 1).EntireRow.Delete
End If
Me.TextBox11.Text = Application.WorksheetFunction.Sum(Range("H3:H1048576"))
รบกวนอาจารย์ช่วยดูหน่อยครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:35 pm
by snasui
:D ประเด็นคือไฟล์นี้มีการ Protect อยู่ ให้ปลดการ Protect เสียก่อนเป็นอันดับแรก ได้ปลดการ Protect ตามที่ผมแจ้งไปแล้วหรือไม่ครับ :?:

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:40 pm
by Leng
ได้ละครับแต่ติดปัญหาคือทำไมเวลา scan แล้ว listbox ต้องขยับเล็กลงตลอดครับ เราสามารถตั้งอะไรได้ไหม

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:45 pm
by snasui
:D Object ต่าง ๆ ถ้าหากเราไม่เขียนการเปลี่ยนขนาดไว้ โปรแกรมไม่ควรจะเปลี่ยนขนาดได้เองครับ ไม่ทราบว่าเล็กลงขนาดไหน อย่างไร เล็กลงเรื่อย ๆ หรือว่าหยุดที่ขนาดที่เท่าไรครับ :?:

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:48 pm
by Leng
scan ทุกครั้ง listbox จะขยับเล็กลงตลอดครับโดยจนบันจบกับบันทัดสุดท้ายที่ scan ทึงมีtabเลื่อนขึ้นมาโชว์ครับ

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 8:51 pm
by snasui
:shock: ลักษณะเช่นนั้นไม่สามารถเดาสาเหตุได้ครับ :|

Re: การ Delete ทีละบันทัดแบบมีเงื่อนไข

Posted: Tue Aug 14, 2018 9:00 pm
by snasui
snasui wrote: Tue Aug 14, 2018 8:51 pm :shock: ลักษณะเช่นนั้นไม่สามารถเดาสาเหตุได้ครับ :|
:D ลองดูว่าปรับค่าตามภาพให้เป็น False แล้วช่วยได้หรือไม่ครับ