อยากให้ตัดรายชื่อและเลื่อนบรรทัดขึ้นมาคนลาออก

[godman]

คือผมมีพนักงานที่ต้องลาออกในแต่ละวัน ครานี้ว่าผมมีรายชื่อพนักงานที่ลาออกในวันนั้น อยู่ใน sheet Resigned ผมอยากเอารายชื่อพนักงานที่ลาออกออกไปจากข้อมูลทุ้งแถวเลย อยากจะ Updated เอาเฉพาะคนอยู่ ผมต้องทำอย่างไรครับ ใช้สูตรหรือจะใช้ VBA ดี แต่ว่าบรรทัดจะต้องเลื่อนติดกันเหมือนเดิมนะครับ
ขอบพระคุณล่วงหน้าครับ

[snasui]

สามารถใช้การ Filter แล้ว Delete ได้เลยครับ ไม่ทราบว่าต้องการให้เป็น Automatic หรือไม่ครับ ถ้า Automatic ด้วยก็แจ้งมาอีกรอบ จะเขียน Code VBA ให้ครับ

[godman]

ใช่ครับ ผมต้องการให้เป็น Automatic เพระว่าจะได้รวดเร็วเมื่อ update รายชื่อไปใช้งานต่อไป ขอบพระคุณล่างหน้าครับ

[snasui]

ลอง Code ตามด้านล่างครับ

Code: Select all

Sub DelCell()
Dim icount As Integer
icount = Range("F65536").End(xlUp).Row
Do
    If Cells(icount, "F") = "ลาออก" Then
        Cells(icount, "F").EntireRow.Delete
    End If
    icount = icount - 1
Loop Until icount = 1
End Sub

[godman]

ผมได้ลองนำไปปรับใช้แล้ว โดยใส่ปุ่ม Updated ที่ชี้ต Updated แต่ว่ามันไม่ตอบสนองอะไรเลย ครับ ตามไฟล์แนบครับ

[snasui]

สร้าง Module ขึ้นมาก่อนแล้วค่อยวาง Code ครับ

ดูตัวอย่างตามไฟล์แนบครับ

[godman]

ใช้ได้แล้วครับ แต่ว่าของผมไม่รับ MACRO ภาษาไทยมั้ง มันเลยกดแล้วไม่ไปในตอนแรก ผมหาสาเหตุพบแล้ว ผมก็เปลี่ยนจากคำว่า ลาออก เป้ฯ Resigned ก็เลยใช้ได้ผลครับ ขอบพระคุณครับ

[godman]

แล้วถ้าผมไม่เขียนคำว่า Resigned ที่หน้า Updated แต่ให้ User เขียนเฉพาะ Sheet Resigned เท่านั้นเพื่อลดขั้นตอนต้องปรับเปลี่ยน VBA อย่างไรบ้างครับ

[snasui]

ไม่เข้าใจครับ ช่วยอธิบายเพิ่มเติมว่าให้ User เขียนอะไรตรงไหน แล้วต้องการให้กระทบอะไรตรงไหน อย่างไรครับ

[godman]

ความต้องการใหม่ครับ
เมื่อกด Macro แล้วให้คนลาออกหายไป
และข้อมูลทั้งแถวมาโผล่ที่ Sheet Resigned
จะได้ไม่ต้องเพิ่มขั้นตอนการพิมพ์ครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub DelCell()
Dim icount As Integer
Dim rt As Range
icount = Range("F65536").End(xlUp).Row
Do
    If Cells(icount, "F") = "Resigned" Then
        Set rt = Worksheets("Resigned").Range("A65536") _
            .End(xlUp).Offset(1, 0)
        Cells(icount, "F").EntireRow.Copy
        rt.PasteSpecial xlPasteValues
        Cells(icount, "F").EntireRow.Delete
    End If
    icount = icount - 1
Loop Until icount = 1
End Sub

[godman]

สุดยอดมากครับ ทึ่งจริงๆ ว่าแต่ว่าถ้าผมอยากเพิ่ม Massage กรณีว่า ไม่มีคนลาออกในวันนี้ ถ้าไม่มีคำว่า Rssinged เมื่อคลิ้ก มันจะขึ้นว่า "Nobody Resigned Today" ต้องเพิ่มโค้ดอย่างไรดีครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub DelCell()
Dim icount As Integer
Dim rt As Range
icount = Range("F65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf( _
    Range("F:F"), "Resigned") = 0 Then
    MsgBox "Nobody Resigned Today"
    Exit Sub
End If
Do
    If Cells(icount, "F") = "Resigned" Then
        Set rt = Worksheets("Resigned").Range("A65536") _
            .End(xlUp).Offset(1, 0)
        Cells(icount, "F").EntireRow.Copy
        rt.PasteSpecial xlPasteValues
        Cells(icount, "F").EntireRow.Delete
    End If
    icount = icount - 1
Loop Until icount = 1
End Sub

[godman]

ใช้ได้ดีมากๆครับ ขอบพระคุณครับ GBU