ย้าย ข้อมูล ไป sheet อืน

[zean]

ตาม file ที่แนบมา

[joo]

ช่วยอธิบายปัญหาและระบุเงื่อนไขพร้อมคำตอบที่ต้องการมาในกระทู้ด้วยครับตามกฎข้อ3

[zean]

sheet 1 เมื่อ พิมคำว่า ลาออก ใน คอลัม F แถวไหน ก็ตาม แถวนั้น จะหาย ไป แล้วจะถูกย้ายไปอยู่ ใน sheet 2

[joo]

การทำเช่นนั้นได้ต้องอาศัย VBA เข้ามาช่วยครับ ซึ่งจำเป็นต้องเขียนมาเองก่อนตามกฎข้อ5 ครับ

[zean]

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

ตอนนี้ ได้แค่ ลบออก จาก sheet1 ครับ อยากให้copy ไป sheet 2 ด้วยครับ

และ อยากให้ตารางใน sheet1 ไม่หายไปด้วย

[snasui]

ลองพยายามเขียนการ Copy ไปวางใน Sheet2 มาด้วย ติดตรงไหนค่อยมาถามกันต่อครับ

[zean]

Sub DelCell()
Dim icount As Integer
Dim ws As Worksheet
Dim r As Integer
Dim rn As Range

Set ws = ActiveSheet

icount = Range("F65536").End(xlUp).Row
Do
If Worksheets("1").Cells(icount, "F") = "ลาออก" Then
Worksheets("1").Cells(icount, "F").EntireRow.Copy _
Worksheets("2").Cells(icount, "A").EntireRow
Worksheets("1").Cells(icount, "F").EntireRow.Delete

End If

icount = icount - 1
Loop Until icount = 1
End Sub



ตอนนี้ copy ได้แล้ว แต่ใน sheet2 ไม่เรียง กันครับ และตารางใน sheet1 หายไป ลำดับไม่เรียงกันด้วย

[snasui]

การวาง Code VBA ให้แสดงเป็น Code ดูที่นี่ครับ viewtopic.php?f=2&t=1187

สำหรับที่ถามมาลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub DelCell()
    Dim icount As Integer
    Dim sh2Range As Range
    'Keep original format
    Worksheets("1").Range("A:E").Copy
    Worksheets("Sheet3").Range("A:E").PasteSpecial xlPasteFormats
    icount = Worksheets("1").Range("F65536").End(xlUp).Row
    Do
        If Worksheets("1").Cells(icount, "F") = "ลาออก" Then
            Worksheets("1").Cells(icount, "F").EntireRow.Copy
            Worksheets("2").Cells(65536, "A").End(xlUp) _
                .Offset(1, 0).PasteSpecial xlPasteValues
            Worksheets("1").Cells(icount, "F").EntireRow.Delete
        End If
        icount = icount - 1
    Loop Until icount = 1
    Worksheets("Sheet3").Range("A:E").Copy
    Worksheets("1").Range("A:E").PasteSpecial xlPasteFormats
   With Worksheets("2")
        Set sh2Range = .Range("A1", .Range("E" & Rows.Count).End(xlUp))
        sh2Range.Borders.LineStyle = xlContinuous
        sh2Range.Sort Key1:=.Range("A2"), Order1:=xlAscending, header:=xlGuess
    End With
End Sub

[zean]

ขอบคุณ ครับ... แล้วถ้าผมต้องการเปลียน จาก ลาออก คอลัม F มาเป็น คอลัม Q
และ copy , paste และ delete เปลียนมาเป็น B ถึง P ต้องแ่ก้ code ตรงไหนบ้าง ครับ

[snasui]

ควรปรับปรุง Code มาเองก่อนเสมอ ติดตรงไหนแล้วค่อยถามกันต่อครับ

[zean]

Code: Select all

Sub DelCell()
    Dim icount As Integer
    Dim sh2Range As Range
    'Keep original format
    Worksheets("1").Range("A:E").Copy
    Worksheets(3).Range("A:E").PasteSpecial xlPasteFormats
    icount = Worksheets("1").Range("F65536").End(xlUp).Row
    Do
        If Worksheets("1").Cells(icount, "F") = "OK" Then
            Worksheets("1").Cells(icount, "F").EntireRow.Copy
            Worksheets("2").Cells(65536, "A").End(xlUp) _
                .Offset(1, 0).PasteSpecial xlPasteValues
            Worksheets("1").Cells(icount, "F").EntireRow.Delete
        End If
        icount = icount - 1
    Loop Until icount = 1
    Worksheets(3).Range("A:E").Copy
    Worksheets("1").Range("A:E").PasteSpecial xlPasteFormats
   With Worksheets("2")
        Set sh2Range = .Range("A1", .Range("E" & Rows.Count).End(xlUp))
        sh2Range.Borders.LineStyle = xlContinuous
        sh2Range.Sort Key1:=.Range("A2"), Order1:=xlAscending, header:=xlGuess
    End With
End Sub

จากโค้ดอยากให้ sheet1 เมื่อ ลำดับที่ถูกลบลำดับต่อไปจะขึ้นมาแทน เช่น เมื่อลบลำดับ 5 ลำดับ6 จะขึ้นมาเป็น ลำดับ 5แทน

คื่ออยากให้มันเรียง 1234567 ไปเรื่อยๆ ไม่ใช้ 123467 ใน sheet2 ก็เหมือน กัน เมื่อcopy ไปแล้ว ให้เริ่มลำดับ 1 และเรียงไปเรื่อยๆ

1234567 ประมาณนี้ ครับ ขอบคุณครับ

[snasui]

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

[zean]

ลองพยายาม แก้ ใน vba แล้วครับ ไม่ได้ สักที่ แล้วลอง ใช้สูตร เข้าช่วย

ตอนนี้ sheet1 เรียงกันแล้ว โดย ใส่สูตร ในลอลัม A =IF(B2<>"",COUNTA($B$2:B2),"")

แต่ใน sheet2 ยังไม่ได้ครับ ใส้แล้วไม่ได้ตามต้องการ ช่วยชี้แนะหน่อยครับ

[snasui]

ที่ชีท 2 ก็ใช้สูตรแบบเดียวกับที่เขียนมาได้ ไม่ทราบว่าที่ลองแล้วติดปัญหาอะไรครับ

[zean]

พอใส้ สูตร =IF(B2<>"",COUNTA($B$2:B2),"") ในคอลัม A sheet2 เมื่อทำการ run vba แล้ว

สูตร ในคอลัม A จะไม่มี เลย ไม่เรียง 123456 ตามไฟทีแนบมา

ช่วยชี้แนะ ด้วยครับ ถ้า ให้อยู่ในโค้ด vba เลยจะดีมาก

[snasui]

ด้วย VBA แล้วสามารถทำได้ทั้งนั้นนั้นครับ เพียงแต่หากต้องการใข้ VBA แล้ว ต้องทำตามกฎข้อ 5 ด้านบนเท่านั้นครับ