เปิดไฟล์ด้วย VBA แล้วต้องการ Auto Filter ตามเงื่อนไข

[parakorn]

เรียนอาจารย์และเพื่อนๆในบอร์ดทุกท่านครับ

จากไฟล์แนบ เมื่อรันโค้ด ต้องการเปิดไฟล์ที่เลือก แล้ว Auto Filter ไฟล์ที่เปิดโดยอ้างอิงจากข้อมูลในไฟล์ที่รันโค้ดครับ

เช่น Runcode เปิดไฟล์ > Check สาขา ในชีท title ที่ D4 > สั่งให้ไฟล์ที่เปิด Filter เลือกตามสาขานั้นๆ > Copy ข้อมูล Item Code,Item Name,Status,Non Sales Day นำกลับมาวางที่ชีท Book1

[snasui]

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

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)
    If TypeName(strPath) = "Boolean" Then Exit Sub
        
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3)"
    Selection.Copy
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    Sheets(1).Select

    Application.CutCopyMode = False

    Application.Goto Reference:="OFFSET(R1C29,1,,COUNTA(C29)-1,)"
    Selection.Copy
    tb.Activate
    Worksheets("Book1").Activate
    With tb.Sheets("book1")
        .Range("D2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    Worksheets("Title").Activate
    Range("a1").Activate
End Sub

[parakorn]

ขอบคุณอาจารย์มากๆเลยครับ

[parakorn]

เนื่องจากมีข้อมูลของ non sale day ใน column ที่ 29 ที่ต้อง Copy มาด้วย แต่มีปัญหาในการประกาศตัวแปร แต่ตัวแปรไม่ทำงานครับ

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook, pb As Workbook
    
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)

    Set pb = ThisWorkbook
    
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    pb.Activate
        Sheets(1).Select
        Application.Goto Reference:="OFFSET(R1C29,1,,COUNTA(C18)-1,1)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("D3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    
    Worksheets("Title").Activate
    Range("a1").Activate
    
End Sub

[puriwutpokin]

เนื่องจากมีข้อมูลของ non sale day ใน column ที่ 29 ที่ต้อง Copy มาด้วย แต่มีปัญหาในการประกาศตัวแปร แต่ตัวแปรไม่ทำงานครับ

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook, pb As Workbook
    
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)

    Set pb = ThisWorkbook
    
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    pb.Activate
        Sheets(1).Select
        Application.Goto Reference:="OFFSET(R1C29,1,,COUNTA(C18)-1,1)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("D3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    
    Worksheets("Title").Activate
    Range("a1").Activate
    
End Sub

ประมาณนี้หรือเปล่าครับ

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)
    If TypeName(strPath) = "Boolean" Then Exit Sub
        
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3),OFFSET(R1C28,1,,COUNTA(C28)-1,1)"
    Selection.Copy
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    Sheets(1).Select
    Application.CutCopyMode = False
    Worksheets("Title").Activate
    Range("a1").Activate
End Sub

[parakorn]

ขอบคุณมากครับ เพิ่งรู้ว่าสามารถ Goto Reference ข้อมูลได้มากกว่า 1 Range