Excel Forum

ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
http://snasui.com/

copy ข้ามชีท (VBA)

http://snasui.com/viewtopic.php?t=12415

Page 1 of 2

copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 9:43 am
by Benmore

Code: Select all

Sub Button1_Click()
 Sheets("การเบิก").Range("A3:H1000").Copy Sheets("การรับ").Range("A3")
End Sub
ถ้าต้องการให้ copy ข้อมูลโดยมีเงื่อไขว่าเอาแค่ข้อมูลที่มี Status เป็นรับแล้ว ต้องเพิ่มตรงไหนค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 1:46 pm
by 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

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 2:41 pm
by Benmore
puriwutpokin wrote:ปรับเป็นตามนี้ครับ

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
ถ้าให้เอาเฉพาะข้อมูลใหม่ ไม่เอาข้อมูลที่ซ้ำกัน ต้องแก้ไขแบบไหนค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 4:15 pm
by puriwutpokin
ลองแนบไฟล์ตัวอย่าง พร้อมโค้ดมาดูครับ และอธิบายว่าซ้ำจากส่วนไหน เงื่อนไขใดบ้างครับ เพื่อนๆสมาชิกจะได้ทดสอบให้ครับ

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 4:20 pm
by Benmore
puriwutpokin wrote:ลองแนบไฟล์ตัวอย่าง พร้อมโค้ดมาดูครับ เพื่อนๆสมาชิกจะได้ทดสอบให้ครับ

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

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 01, 2017 10:28 pm
by snasui
:D ไฟล์ที่จะแนบ Code ได้จะต้องเป็น .xlsm เป็นอย่างน้อยครับ ลองแนบมาใหม่ ถ้าหากไฟล์นี้ไม่ใช่ไฟล์โปรแกรมก็ให้แนบไฟล์โปรแกรมมาด้วยครับ

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 02, 2017 8:30 am
by Benmore
exc.xlsm

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 02, 2017 8:25 pm
by snasui
:D จะพิจารณา 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

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 02, 2017 10:12 pm
by Benmore
ลองนำโค้ดที่แนะนำไปแก้แล้ว พอรันก็ไม่มีอะไรเกิดขึ้นเลยค่ะ เป็นเพราะอะไรค่ะ :shock:

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 02, 2017 10:21 pm
by snasui
:D ควรทดลองกับไฟล์ที่ส่งมาถามว่าได้ผลหรือไม่ อย่างไร

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

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 02, 2017 10:47 pm
by Benmore
ทำได้แล้ว ขอบคุณมากค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Tue Nov 07, 2017 9:53 am
by Benmore
ขอสอบถามเพิ่มเติมค่ะ
ถ้าต้องการลบข้อมูลในชีทการเบิก แล้วให้ข้อมูลในชีทการรับลบไปด้วยต้องเพิ่มโค้ดตรงไหนค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Tue Nov 07, 2017 10:39 am
by 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

Re: copy ข้ามชีท (VBA)

Posted: Tue Nov 07, 2017 1:16 pm
by Benmore
ลองเอาโค้ดไปปรับแล้วค่ะ แต่มันเป็นว่าเมื่อกดปุ่ม แล้วข้อมูลที่รับแล้วถูก Cut ไปชีทการรับเลยค่ะ
ที่ต้องการคือให้ copy ไปที่ชีทการรับแล้วถ้า เมื่อชีทการเบิกที่มีสถานะว่ารับแล้วถูกลบไป ข้อมูลในชีทการรับก็จะถูกลบไปด้วยค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Tue Nov 07, 2017 6:37 pm
by snasui
Benmore wrote:ขอสอบถามเพิ่มเติมค่ะ
ถ้าต้องการลบข้อมูลในชีทการเบิก แล้วให้ข้อมูลในชีทการรับลบไปด้วยต้องเพิ่มโค้ดตรงไหนค่ะ
:D มีวิธีการลบอย่างไร เป็นการลบด้วยมือหรือลบด้วย Code หากลบด้วย Code ช่วยแนบ Code ที่ได้เขียนสำหรับการลบข้อมูลมาด้วยครับ

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 08, 2017 4:18 pm
by 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 ข้อมูลจากชีทการเบิกไปยังชีทการรับ แต่ที่ต้องการคือ ข้อมูลในชีทการเบิกที่มีสถานะเป็นมารับแล้ว จะถูกคัดลอกไปยังชีทการรับ แต่ถ้าข้อมูลในชีทการเบิกที่มีสถานะเป็นมารับแล้วถูกลบออกไปข้อมูลในชีทการรับก็ต้องถูกลบไปด้วยค่ะ

Re: copy ข้ามชีท (VBA)

Posted: Wed Nov 08, 2017 6:41 pm
by snasui
:D Code ตามโพสต์ #16 ไม่มีการ Cut มีแต่การคัดลอกไปวางแล้วลบรายการที่นำไปวาง ก่อนที่จะวางมีการตรวจสอบก่อนว่าไม่มีรายการนั้นในชีต รับแล้ว และเมื่อไม่มีจึงไม่สามารถที่จะลบจากรายการที่ไม่มีได้

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

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 09, 2017 8:17 am
by Benmore
Ex. ข้อมูล ชีท การเบิก
รหัส 0008 นาย ก เบิกเลื้อ1ตัว สถานะ มารับแล้ว
รหัส 0009 นาย ข เบิกเลื้อ2ตัว สถานะ มารับแล้ว
รหัส 0003 นาย ค เบิกเลื้อ4ตัว สถานะ ไม่มารับ
รหัส 0002 นาย ง เบิกเลื้อ5ตัว สถานะ มารับแล้ว

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

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

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

ชีท การรับ

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

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 09, 2017 3:07 pm
by 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

Re: copy ข้ามชีท (VBA)

Posted: Thu Nov 09, 2017 8:38 pm
by Benmore
ลองเอาโค้ดไปแก้ไขตามที่บอกแล้วค่ะ แต่เมื่อลบข้อมูลในชีทการเบิก ข้อมูลในชีทการรับก็จะเพิ่มข้อมูลที่เราลบจากชีทการเบิกค่ะ
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited