copy ข้ามชีท (VBA)

[Benmore]

Code: Select all

Sub Button1_Click()
 Sheets("การเบิก").Range("A3:H1000").Copy Sheets("การรับ").Range("A3")
End Sub

ถ้าต้องการให้ copy ข้อมูลโดยมีเงื่อไขว่าเอาแค่ข้อมูลที่มี Status เป็นรับแล้ว ต้องเพิ่มตรงไหนค่ะ

[puriwutpokin]

ปรับเป็นตามนี้ครับ

Code: Select all

Sub Button1_Click()
Dim rAll As Range, r As Range
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With
End Sub

[Benmore]

ปรับเป็นตามนี้ครับ

Code: Select all

Sub Button1_Click()
Dim rAll As Range, r As Range
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With
End Sub

ถ้าให้เอาเฉพาะข้อมูลใหม่ ไม่เอาข้อมูลที่ซ้ำกัน ต้องแก้ไขแบบไหนค่ะ

[puriwutpokin]

ลองแนบไฟล์ตัวอย่าง พร้อมโค้ดมาดูครับ และอธิบายว่าซ้ำจากส่วนไหน เงื่อนไขใดบ้างครับ เพื่อนๆสมาชิกจะได้ทดสอบให้ครับ

[Benmore]

ลองแนบไฟล์ตัวอย่าง พร้อมโค้ดมาดูครับ เพื่อนๆสมาชิกจะได้ทดสอบให้ครับ

Code: Select all

Sub Button14_Click()
Dim rAll As Range, r As Range
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "ได้รับแล้ว") Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With
End Sub

[snasui]

ไฟล์ที่จะแนบ Code ได้จะต้องเป็น .xlsm เป็นอย่างน้อยครับ ลองแนบมาใหม่ ถ้าหากไฟล์นี้ไม่ใช่ไฟล์โปรแกรมก็ให้แนบไฟล์โปรแกรมมาด้วยครับ

[Benmore]

exc.xlsm

(47.89 KiB) Downloaded 20 times

[snasui]

จะพิจารณา Emp_ID กับ Name หากซ้ำจะไม่นำไปแสดงครับ

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

Code: Select all

With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With

[Benmore]

ลองนำโค้ดที่แนะนำไปแก้แล้ว พอรันก็ไม่มีอะไรเกิดขึ้นเลยค่ะ เป็นเพราะอะไรค่ะ

[snasui]

ควรทดลองกับไฟล์ที่ส่งมาถามว่าได้ผลหรือไม่ อย่างไร

ไฟล์ที่แนบมาล่าสุดข้อมูลอยู่ชีตใด Code อยู่ที่ Procedure ใด ชื่ออะไร ควรตัดมาเฉพาะที่เกี่ยวข้องเท่านั้นจะได้เข้าถึงปัญหาโดยไวครับ

[Benmore]

ทำได้แล้ว ขอบคุณมากค่ะ

[Benmore]

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

[puriwutpokin]

ปรับเป็น

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
            r.Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next r
End With
Application.ScreenUpdating = True
End Sub

[Benmore]

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

[snasui]

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

มีวิธีการลบอย่างไร เป็นการลบด้วยมือหรือลบด้วย Code หากลบด้วย Code ช่วยแนบ Code ที่ได้เขียนสำหรับการลบข้อมูลมาด้วยครับ

[Benmore]

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
            r.Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next r
End With
Application.ScreenUpdating = True
End Sub

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

[snasui]

Code ตามโพสต์ #16 ไม่มีการ Cut มีแต่การคัดลอกไปวางแล้วลบรายการที่นำไปวาง ก่อนที่จะวางมีการตรวจสอบก่อนว่าไม่มีรายการนั้นในชีต รับแล้ว และเมื่อไม่มีจึงไม่สามารถที่จะลบจากรายการที่ไม่มีได้

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

[Benmore]

Ex. ข้อมูล ชีท การเบิก
รหัส 0008 นาย ก เบิกเลื้อ1ตัว สถานะ มารับแล้ว
รหัส 0009 นาย ข เบิกเลื้อ2ตัว สถานะ มารับแล้ว
รหัส 0003 นาย ค เบิกเลื้อ4ตัว สถานะ ไม่มารับ
รหัส 0002 นาย ง เบิกเลื้อ5ตัว สถานะ มารับแล้ว

คัดลอกแล้วไปยังชีท การรับ

ชีท การรับ
รหัส 0008 นาย ก เบิกเลื้อ1ตัว สถานะ มารับแล้ว
รหัส 0009 นาย ข เบิกเลื้อ2ตัว สถานะ มารับแล้ว
รหัส 0002 นาย ง เบิกเลื้อ5ตัว สถานะ มารับแล้ว

เมื่อ ข้อมูลในชีทการเบิกของนาย ก ถุกลบออกไปข้อมูลในชีทการรับของนาย ก ก็ถูกลบไปด้วย
Ex.
ชีท การเบิก

รหัส 0009 นาย ข เบิกเลื้อ2ตัว สถานะ มารับแล้ว
รหัส 0003 นาย ค เบิกเลื้อ4ตัว สถานะ ไม่มารับ
รหัส 0002 นาย ง เบิกเลื้อ5ตัว สถานะ มารับแล้ว

ชีท การรับ

รหัส 0009 นาย ข เบิกเลื้อ2ตัว สถานะ มารับแล้ว
รหัส 0002 นาย ง เบิกเลื้อ5ตัว สถานะ มารับแล้ว

[puriwutpokin]

ลองดูตามโค้ดนี้ครับ

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
Dim i As Long
With Sheets("การเบิก")
    For i = 100 To 1 Step -1
If .Range("h" & i).Value = "รับแล้ว" And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), .Range("h" & i).Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), .Range("h" & i).Offset(0, -6).Value) > 0 Then
            .Range("h" & i).Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next i
   With Sheets("การรับ")
 .Range("a3:h" & Application.CountIf(.Range("a3:a" & .Rows.Count), "<>") + 2).ClearContents
    End With
    For i = 1 To 100
If .Range("h" & i).Value = "รับแล้ว" Then
      .Range("h" & i).Offset(0, -7).Resize(1, 8).Copy
             With .Application.Sheets("การรับ")
               .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                   .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
       End If
    Next i
End With
End Sub

[Benmore]

ลองเอาโค้ดไปแก้ไขตามที่บอกแล้วค่ะ แต่เมื่อลบข้อมูลในชีทการเบิก ข้อมูลในชีทการรับก็จะเพิ่มข้อมูลที่เราลบจากชีทการเบิกค่ะ