Macro | สอบถามการใช้คำสั่งเพื่อจัดวาง Data Row แบบสะสม

[SaturdayAugust™]

สวัสดีครับ ท่าน Administrator ผมมีคำถามจะรบกวนขอความช่วยเหลือดังนี้ครับ

ผมต้องการเขียน Macro ดังนี้ครับ

1 นำรายการใน Sheet1 ทุก Row ไปวางใน Sheet3
2 นำรายการใน Sheet2 ทุก Row ไปวางใน Sheet3 โดย
2.1 รายการใหม่ต้องไม่ทับรายการเก่า
2.2 รายการใหม่ต้องต่อท้ายจากรายการเก่า
(ซึ่งในบางครั้งจำนวน Row อาจมีมาก/น้อยต่างกันไป)

โดยผมจะเอาไปใช้ประโยชน์ในการประมวลผลเพื่อคัดกรองข้อมูลซึ่งจะมีเข้ามาเป็นระยะๆ และต้องสะสมไปเรื่อยๆ ครับ

ขอบคุณล่วงหน้าครับ

[SaturdayAugust™]

ขออภัยครับ เมื่อสักครู่ผมลืมแนบ File ครับ (Base on MS-Office 2003)

[snasui]

ปกติข้อมูลใน Sheet1 และ Sheet2 มีหัว Field (หัวคอลัมน์) หรือเปล่าครับ เพราะถ้ามีหัว Field จะต้องเว้นหัวไว้ 1 บรรทัดและ้ข้อมูลจะเริ่มบรรทัดที่ 2 เป็นต้นไป

การเขียน Code แบบมีและไม่มีหัว Filed จะแตกต่างกันครับ

[SaturdayAugust™]

เรียน คุณคนควน

มี Head Column ด้วยครับ แต่หากเป็นไปได้ ผมขอความรู้เพิ่มเติมในความต่างของ Code ในการเขียนของทั้ง 2 กรณีด้วยจะดีมากๆ เลยครับ เอาไว้ประดับความรู้ เผื่อจะได้เอาไปประยุกต์ใช้ในกรณีอื่นซึ่งก็จะมีมาอีกแล้วเร็วๆ นี้ครับ

ขอบคุณครับ

[snasui]

ผมเขียนตัวอย่าง Code ให้แล้วตามไฟล์แนบครับ

[SaturdayAugust™]

เรียน คุณคนควน

ผมเจอปัญหาเข้าแล้วครับ จาก File ที่คุณคนควนได้กรุณาทำมาให้ผมล่าสุด อ้างอิง "Ans_RecordMultipleRangeToDatabase.xls [58.5 KiB]" เมื่อผมนำ Script ไป Apply ใช้กับ Script ที่ผมเขียนขึ้นเพื่อให้การทำงานต่อเนื่องกันจากขั้นตอนอื่น ประเด็นอยู่ตรงนี้ครับ

ในบางครั้ง Sheet1 หรือ Sheet2 อาจจะไม่มีข้อมูลรายการสำหรับรอบนั้นๆ ครับ แต่เมื่อ Run Script แล้วจะพบว่ามีการนำเอา Row 1 ไปวางใน Sheet3 หมดเลยครับ

รบกวนขอความกรุณาชี้แนะด้วยครับ

ขอบคุณครับ

[snasui]

ลองใช้ Code ตามด้านล่างครับ

Code: Select all

Option Explicit

Sub SendToPaste()
Dim r1 As Range
Dim r2 As Range
    With Worksheets("Sheet1")
       Set r1 = .Range(.Range("A2"), .Range("J65536").End(xlUp))
    End With
    With Worksheets("Sheet2")
       Set r2 = .Range(.Range("A2"), .Range("J65536").End(xlUp))
    End With
       PasteData r1
       PasteData r2
    MsgBox "Complete"
End Sub

Sub PasteData(r)
Dim r3 As Range
Dim i As Integer
With Worksheets("Sheet3")
       i = .Range("A65536").End(xlUp).Row + 1
       Set r3 = .Cells(i, "A")
End With
       If r.Row <> 1 Then
            r.Copy r3
        End If
End Sub

ให้เรียกใช้ Code ที่ชื่อว่า SendToPaste ครับ