VBA code coy ข้อมูลจากไฟล์ปิดหลายไฟล์บันทึกต่อที่แถวว่าง

[phatpiti.s]

ผมต้องการเขียน VBA code ให้คัดลอกข้อมูลจาก Cell A2 และเลือกทั้งหมดในไฟล์ชื่อ db1.xlsx
และมาวางต่อแถวว่างในไฟล์ชื่อ db.xlsx ตอนนี้ทำได้แล้วครับ
แต่มีคำถามว่าถ้าสมมติว่าผมมีไฟล์ข้อมูลหลายไฟล์ เช่น db1,db2,db3,.....dbxxx
ผมจะเขียนคำสั่งให้มันวนลูป Copy และบันทึกต่อท้ายไปเรื่อย ๆ อย่างไรครับ ?

ขอบคุณครับ

Code: Select all

Private Sub CommandButton1_Click()
   ActiveSheet.Range("A2", _
   ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.ClearContents
    Dim wb1 As Variant
    Application.DisplayAlerts = False
    Set wb1 = Workbooks.Open("D:\My Documents\Desktop\db1.xlsx", False, False)
    Windows("db1.xlsx").Activate
    ActiveSheet.Range("A2", _
   ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.Copy
    Windows("db.xlsm").Activate
   Range("A65000").End(xlUp).Offset(1, 0).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     wb1.Close True
    MsgBox ("บันทึกเสร็จแล้ว")
End Sub

[snasui]

ลองดูตัวอย่างการปรับ Code ตามด้านล่าง โดยระบุชื่อไฟล์ที่ต้องการจะ Loop ค่ามาวางไว้ในช่วงเซลล์ Z1:Z100 และไม่ต้องใส่นามสกุลไฟล์ เนื่องจากใส่ไว้ใน Code แล้ว

Code: Select all

Private Sub CommandButton1_Click()
    ActiveSheet.Range("A2", _
    ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.ClearContents
    Dim wb1 As Variant
    Application.DisplayAlerts = False
    For Each r In Range("z1:z100")
        Set wb1 = Workbooks.Open("D:\My Documents\Desktop\" & r & ".xlsx", False, False)
        Windows(wb1).Activate
        ActiveSheet.Range("A2", _
        ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
        Selection.Copy
        Windows("db.xlsm").Activate
        Range("A65000").End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
         wb1.Close True
    Next r
    MsgBox ("Finish')
End Sub

[phatpiti.s]

ขอบคุณมากครับ

มีปัญหาเพิ่มเติมนิดนึงครับตรง Code ด้านล่างจะมีปัญหาว่าถ้าเซลล์ว่างไม่มีข้อมูล
หรือข้อมูลบรรทัดเว้นบรรทัดมันจะ Error ครับ ไม่ทราบว่าพอมีทางแก้ไขสูตรใหม่
ให้ Copy range ที่มีข้อมูลทั้งหมดแม้จะเว้นบรรทัดหรือถ้าเป็นเซลล์ว่างก็ไม่ Error ได้ไหมครับ ?

ActiveSheet.Range("A2", _
ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
Selection.Copy

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

    ActiveSheet.Range("A2", _
        ActiveSheet.Range("IV" & ActiveSheet.Range("A" & Rows.Count) _
        .End(xlUp).Row).End(xlToLeft)).Select
    Selection.Copy

[phatpiti.s]

ขอบพระคุณมากครับอาจารย์
โปรแกรมใช้ได้ดีเลยครับ

[phatpiti.s]

สอบถามเพิ่มเติมครับอาจารย์

คำสั่งให้หาเซลล์สุดท้ายที่ใช้เพื่อนำข้อมูลไปบันทึกต่อท้ายมีปัญหาครับ
ตอนแรกผมใช้คำสั่งนี้คือ

Code: Select all

Range("A65000").End(xlUp).Offset(1, 0).Select

ซึ่ง Run เครื่องผมไม่มีปัญหา แต่พอไปใช้กับเครื่องอื่นมันขึ้น Run time error ที่บรรทัดนี้ตลอดเลยครับ

พอทดลองเปลี่ยนคำสั่งเป็น

Code: Select all

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

ก็ยังขึ้น Error เหมือนเดิมแต่ Run ที่เครื่องผมไม่มีปัญหาใด ๆ
มันเกิดจากอะไรครับ ?

[snasui]

ช่วยจับภาพการฟ้อง Error มาแสดงด้วยครับ

[phatpiti.s]

ขึ้น Run time error '1004' , Select method of range class failed ครับ
พอเปิดโปรแกรมเข้าไปก็ขึ้นสีเหลืองตรงบรรทัดที่แจ้ง Code นี้ครับ

Code: Select all

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

[snasui]

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

[phatpiti.s]

รบกวนอาจารย์ตรวจสอบครับ
ผมแนบไฟล์ให้แล้วครับ

ขอบคุณมากครับ

[snasui]

ในเครื่องผมก็ไม่ติดปัญหาใดครับ

ลองเพิ่มการ Select Sheet เข้าไปด้วยดูตามตัวอย่างด้านล่างครับ

Code: Select all

'Other code
If Worksheets("Record").Range("A2") = vbNullString Then
    MsgBox ("File db no data")
    wb.Close True
Else
    ActiveSheet.Range("A2", _
    ActiveSheet.Range("IV" & ActiveSheet.Range("A" & Rows.Count) _
        .End(xlUp).Row).End(xlToLeft)).Select
    Selection.Copy
    Windows("db.xlsm").Activate
    Sheets("Sheet1").Select
    Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    wb.Close True
End If
'Other code

[phatpiti.s]

ทดลองเพิ่มแล้วก็ยัง Error บรรทัดเดิมครับ
"ม่ทราบว่าถ้าจะแก้ไข Code ด้านล่างให้เป็นแบบอื่น
จะเปลี่ยนวิธีแบบไหนได้อีกครับอาจารย์?
หรือเกี่ยวกับคำสั่ง count,offset หรือเปล่าครับ ?

Code: Select all

Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select

[snasui]

ลองดูตัวอย่างการปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim wb As Workbook
    Dim currBook As Workbook
    Set currBook = Workbooks("db.xlsm")
    With currBook.Sheets("Sheet1")
        .Range("A2", .Range("A2").End(xlDown).End(xlToRight)).ClearContents
    End With
    'db copy
    Application.DisplayAlerts = False
    Set wb = Workbooks.Open("D:\My Documents\Desktop\db.xlsx", False, False)
    If wb.Sheets("Record").Range("A2") = "" Then
        MsgBox "File db no data"
    Else
        With wb.Worksheets("Record")
            .Range("A2", .Range("IV" & .Range("A" & Rows.Count) _
                .End(xlUp).Row).End(xlToLeft)).Copy
        End With
        currBook.Sheets("Sheet1").Range("a" & Rows.Count) _
            .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
    wb.Close True
End Sub

[phatpiti.s]

ขอบคุณมากครับอาจารย์
โปรแกรม Run ได้สมบูรณ์แล้วครับ

สังเกตวิธีแก้ของอาจารย์คือไม่ใช้คำสั่ง .Select เลยใช่ไหมครับ ?
โดยใช้เทคนิค With กับ End with มาแทน
แสดงว่า VB มักจะ Error ถ้าเราใช้คำสั่ง Select sheet หรือ cells มากเกินไปใช่ไหมครับ ?

[snasui]

แสดงว่า VB มักจะ Error ถ้าเราใช้คำสั่ง Select sheet หรือ cells มากเกินไปใช่ไหมครับ ?

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

ในกรณีนี้ปัญหาคือใช้ได้บางเครื่อง ใช้ไม่ได้บางเครื่อง เพื่อลดเวลาที่จะหาสาเหตุ ผมเลยเขียนเป็น VBA แทน Code ที่ได้จาการบันทึก Macro เพื่อจะดูว่ายังมีปัญหาอีกหรือไม่ และยินดีด้วยที่ไม่เกิดปัญหาครับ

[bank9597]

ผมคิดว่าการใช้ .select เป็นการเขียนของคนที่เพิ่งเริ่มต้นเขียน หรือ ยังไม่มีความชำนาญในการเขียนโค๊ด (เช่นผม) แต่สำหรับมืออาชีพแล้ว เค้าจะใช้แบบสั้นๆ เน้นการประกาศตัวแปรมากกว่า

แต่อย่างไร ผมคิดว่าทุกคนก็เริ่มมากจากพื้นฐานก่อนทั้งนั้น ก่อนจะเข้าใจแบบลึกๆและใช้วิธีลัดได้