สอบถามเขียน Code เพื่อหา Conditionของ Column และ Copy ทั้งแถว ครับ

[sarapao555]

สวัสดีครับ
ผมได้ลองเขียน Code Macro ของ Excel ดูครับ
1.มีไฟล์ข้อมูลชื่อไฟล์ data อยากจะค้นหาเลขในคอลัม B โดยใช้เงื่อนที่กำหนดครับ เช่น >0
2.แล้วทำการ Copy ทั้งแถว มา Paste ไปยัง Sheet2 ของอีกไฟล์ ชื่อไฟล์ Book1 ครับ

แต่ลองเขียนแล้ว Loop ไม่หมุนครับ
นี่ Code ครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Windows("data.xlsx").Activate

Dim i As Integer

For i = 1 To 1000

If Cells(i, 2).Value > 0 Then

Windows("data.xlsx").Activate
Rows(i).Select
Selection.Copy

Windows("Book1.xlsx").Activate
Worksheets("Sheet2").Activate

Rows(i).Select
ActiveSheet.Paste
Application.CutCopyMode = False

End If

Next i

End Sub

จากลองทดสอบว่าใช้ Loop ถูกต้องไหม
โดยใช้ Code นี้ครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Windows("data.xlsx").Activate

Dim i As Integer
Dim x As Integer

For i = 1 To 1000

If Cells(i, 2).Value > 0 Then
Windows("data.xlsx").Activate
Rows(i).Select
Selection.Copy

Windows("Book1.xlsx").Activate
Worksheets("Sheet2").Activate

x = i + 1
Rows(x).Select
ActiveSheet.Paste
Application.CutCopyMode = False

End If

Next i

End Sub

ปรากฎว่า Copy + Paste ได้ครับ Loop หมุน
แต่แถวเคลื่อนเพิ่มมา 1 แถว ครับ

พอดีผมเป็นมือใหม่ เริ่มหัดเขียนcode ครับ
อยากจะรบกวนขอคำแนะนำด้วยครับ ว่าควรจะดัดแปลงแก้ไข Code ยังไงให้ Loop หมุนได้ แถวไม่เคลื่อน ครับ
ขอบคุณครับ

[sarapao555]

รูปภาพประกอบ ครับ
ขอโทษจริงๆ ครับ ใส่รูปไปพร้อมตั้งกระทู้แต่พอกดแล้วเพิ่มไม่ได้ ครับ

[sarapao555]

รูปสุดท้าย ครับ

[DhitiBank]

ไม่พบมาโครในไฟล์ Book1 ครับ หากจะใส่มาโครด้วยต้องบันทึกไฟล์เป็นนามสกุล xlsm หรือ xlsb ครับ

สำหรับโค้ด หากทำงานกับไฟล์หลายไฟล์ควรใส่ parent ในการอ้างอิงตำแหน่งด้วยครับ ลองปรับเป็นแบบนี้ครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Windows("data.xlsx").Activate

Dim i As Integer
Dim x As Integer

For i = 1 To 1000
        If Workbooks("data.xlsx").Sheets(1).Cells(i, 2).Value > 0 Then
                Windows("data.xlsx").Activate
                Rows(i).Select
                Selection.Copy
                
                Windows("Book1.xlsx").Activate
                Worksheets("Sheet2").Activate
                
                x = i
                Rows(x).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
        End If
Next i
End Sub

[sarapao555]

สวัสดีครับ
ขอบคุณมาก นะครับ สามารถ วนLoop ได้แล้วครับ แถวไม่เคลื่อนครับ

ต้องขออภัยจริงๆ ที่ไม่ได้ใส่ Macro ไปด้วยในไฟล์ Book1 ครับ
ผมได้ทำการใส่ Macro1 ไว้ในไฟล์ Book1.xlsm ครับ
อยากจะอัพโหลดไปแก้ไฟล์เก่า แต่ไม่เห็นปุ่มกดให้แก้ไขครับ
เลยขออนุญาต อัพโหลดไฟล์ในโพสต์ตอบกระทู้นี้นะครับ

[bank9597]

ลองดูโค๊ดนี้ครับ วางใน Book1.xlsm

Code: Select all

Option Explicit

Public Sub FindByCon()
    Dim MainWB As Workbook
    Dim DataWB As Workbook
    Dim objSheet As Worksheet
    Dim objDesSheet As Worksheet
    Dim objDesRange As Range
    Dim lngDataLastRow As Long
    Dim lngMainLastRow As Long
    Dim objRange As Range
    
    Set MainWB = Workbooks("Book1")
    Set DataWB = Workbooks("data")
    Set objSheet = DataWB.Sheets("Sheet1")
    Set objDesSheet = MainWB.Sheets("Sheet2")
    lngDataLastRow = f_LastRow("data", "Sheet1", "B")
    
    Set objDesRange = objSheet.Range("B4:B" & lngDataLastRow)
    
    For Each objRange In objDesRange
        If objRange > 0 Then
            objRange.Offset(0, 0).Resize(1, 4).Copy
            lngMainLastRow = f_LastRow("Book1", "Sheet2", "A") + 1
            objDesSheet.Range("A" & lngMainLastRow).PasteSpecial xlPasteValues
        End If
    Next objRange
    
    Set objSheet = Nothing
    Set objDesSheet = Nothing
    Set objRange = Nothing
    Set objDesRange = Nothing
    Set DataWB = Nothing
    Set MainWB = Nothing
    
End Sub

Public Function f_LastRow(ByVal strWBook As String, ByVal strSheet As String, ByVal strRange As String) As Long
        f_LastRow = Workbooks(strWBook).Worksheets(strSheet).Range(strRange & Workbooks(strWBook).Worksheets(strSheet).Rows.Count).End(xlUp).Row
End Function

เปิดไฟล์ Data ขึ้นมา Run Code "FindByCon"