อยากสอบถาม ผมจะ copy field collumn A7,C7,D7, ลงในอีก 1 sheet ใน workbook เดียวกัน ที่มี criteria ว่า field O7 <>0

[bkkrong]

สมมุติ ว่า ผมมี ข้อมูลหลักใน sheet1 อยากให้ระบบตรวจสอบข้อมูลใน field O ถ้าตรงตามเงื่อนไข ให้นำ field ต่างๆที่เลือกไว้ copy ใน sheet"ssjExport"
อยากสอบถาม ผมจะ copy field collumn A7,C7,D7, ลงในอีก 1 sheet ใน workbook เดียวกัน ที่มี criteria ว่า field O7 <>0 จะเขียน vba อย่างไรครับ ถ้ามีข้อมูล 400 แถว และให้ vba ทำแบบนี้จนจบ rec ทั้งหมด

[parakorn]

แนบไฟล์ตัวอย่างมาด้วยเพื่อให้เพื่อนๆเข้าถึงปัญหาได้ง่าย และ สะดวกต่อการตอบคำถามครับ

[bkkrong]

สรปคือ ถ้า collumn O มีค่า =0 ไม่ copy row นี้
ถ้า collumn O มีค่า <>0 ไม่ copy row นี้ ไปอีก sheet ชื่อ ssjExport แต่ให้ระบบสามารถเลือกว่า จะเอา collumn ใดบ้างไปวางครับ

[bkkrong]

อีกครั้ง
ถ้า collumn O มีค่า <>0 ให้ copy row นี้ ไปอีก sheet ชื่อ ssjExport แต่ให้ระบบสามารถเลือกว่า จะเอา collumn ใดบ้างไปวางครับ

[snasui]

VBA ต้องเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 4 และ 5 ด้านบน ติดตรงไหนค่อยนำมาถามกันครับ

[bkkrong]

ตอนนี้ติดอยู่ 2 ที่ ครับคือ
ถาม criteria if ได้ ผม cop ได้แต่ ทั้ง row ยังเขียนแยกว่า จะเอา column ที่ต้องการ cop ไม่ได้ครับ
อีกปัญาหาหนึ่งคือ ตอนนี้ ทำ if แล้ว ระบบไม่พบ citeria column O <> 0 ครับ เลยไม่ cop ซักแถวเลยครับ
ขอบคุณครับ

Sub Copyitem_buy()
Dim r1 As Range, r2 As Range, rt As Range, rs As Range, LR As Long
With Worksheets("sheet1")
Set r1 = .Range("A2", .Range("B65536").End(xlUp))
Set r2 = r1.Offset(0, 2).Resize(, 9) 'copy 8 collum count from offset 0
Set rs = Union(r1, r2)
End With

If Worksheets("sheet1").Range("O3").End(xlUp) <> 0 Then
Set rt = Worksheets("ssjExport_Q1").Range("A6").End(xlUp).Offset(1, 0)
rs.Copy rt
Application.CutCopyMode = False
MsgBox "Finish copy."
Else

MsgBox "no copy"
End If


End Sub

[snasui]

แนบไฟล์นั้นมาถามกัน สำหรับการวางโค้ดในช่องความกรุณาอ่านกฎข้อ 5 ด้านบนประกอบครับ

[bkkrong]

Code: Select all

Sub Copyitem_buy()
Dim r1 As Range, r2 As Range, rt As Range, rs As Range, LR As Long
With Worksheets("sheet1")
Set r1 = .Range("A2", .Range("B65536").End(xlUp))
Set r2 = r1.Offset(0, 2).Resize(, 9) 'copy 8 collum count from offset 0
Set rs = Union(r1, r2)
End With

If Worksheets("sheet1").Range("O3").End(xlUp) <> 0 Then
Set rt = Worksheets("ssjExport_Q1").Range("A6").End(xlUp).Offset(1, 0)
rs.Copy rt
Application.CutCopyMode = False
MsgBox "Finish copy."
Else

MsgBox "no copy"
End If


End Sub

แบบนี้หรือเปล่าครับ

[snasui]

แนบ Code มาถูกต้องแล้ว ช่วยแนบไฟล์ที่มี Code นี้มาด้วยจะได้ตอบต่อไปจากนั้นครับ

[bkkrong]

หมายถึง attach ไฟล์ xls ทั้งหมด ที่มีส่วนของ. code นี้ มาด้วยใช่ไหมครับ

[snasui]

เข้าใจถูกแล้วครับ

[bkkrong]

แนบ file ให้แล้วครับ อาจารยื

[snasui]

สมมุติ ว่า ผมมี ข้อมูลหลักใน sheet1 อยากให้ระบบตรวจสอบข้อมูลใน field O ถ้าตรงตามเงื่อนไข ให้นำ field ต่างๆที่เลือกไว้ copy ใน sheet"ssjExport"
อยากสอบถาม ผมจะ copy field collumn A7,C7,D7, ลงในอีก 1 sheet ใน workbook เดียวกัน ที่มี criteria ว่า field O7 <>0 จะเขียน vba อย่างไรครับ ถ้ามีข้อมูล 400 แถว และให้ vba ทำแบบนี้จนจบ rec ทั้งหมด

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Copyitem_buy()
    Dim r1 As Range, rt As Range, rs As Range, r As Range
    With Worksheets("sheet1")
        Set r1 = .Range("A7", .Range("A65536").End(xlUp))
    End With
    For Each r In r1
        If r.Offset(0, 14).Value <> 0 And IsNumeric(r.Offset(0, 14).Value) Then
            With Worksheets("Sheet1")
                Set rs = Union(r.Offset(0, 0), r.Offset(0, 2), r.Offset(0, 3))
            End With
            Set rt = Worksheets("ssjExport_Q1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            rs.Copy rt
            Application.CutCopyMode = False
        End If
    Next r
End Sub

[bkkrong]

ขอบคุณครับ