รวม Data จากหลายๆ Sheet ด้วย VBA แล้วเครื่อง hang

[prawitj]

พอดีผม จะทำการรวม File Booking จากแต่ละสาขา โดยทำ Pivot ดึง Data มา(แต่ละสาขาใน File ตัวอย่างเสมือนเป็น Pivot นะครับ) จากนั้นใน Sheet "All" ให้คนรวมกด ปุ่ม Transfer มันก็จะดึง Data เฉพาะตัวที่ยังไม่มีใน "All" มาบันทึกต่อท้าย
แต่พอเขียน Code แล้วมัน Hang น่ะครับ เพราะผม ซ้อน loop เยอะเกินไปหรือเปล่า อาจเจอ Infinite loop โดยไม่รู้ตัว พยายามหาแล้ว หาไม่เจอครับ
ที่ต้องซ้อน loop เยอะเพราะผมจะเช็คว่า ถ้าเคย บันทึก "Booking Index" ที่ Worksheets("All") แล้ว ให้กระโดดข้าม เนื่องจาก ต้องนำ Sheet "all" ไปบันทึกเลข "PO" ต่อครับ ผมเลยไม่กล้าที่จะ mark status ไว้ที่ Sheet สาขา เพราะกลัวดึง Pivot แล้วจะเคลื่อน

ผม ตั้งใจจะบันทึกเฉพาะ Booking Index น่ะครับ ส่วนพวก Detail จะใช้ Vlookup ดึงมา ต่างหาก

รบกวนอาจารย์ช่วยดู Code ผมแล้วชี้แนะให้หน่อยครับว่าผิดพลาดตรงไหนทำไม มัน hang เหมือนหลุดจาก Loop ไม่ได้

[snasui]

ผม ตั้งใจจะบันทึกเฉพาะ Booking Index น่ะครับ ส่วนพวก Detail จะใช้ Vlookup ดึงมา ต่างหาก

ผมเขียนตัวอย่าง Code มาให้ตามด้านล่างครับ ซึ่งจะดึงมาเฉพาะ Booking Index จากชีทต่าง ๆ ที่ยังไม่มีในชีท All

Code: Select all

Sub RetriveBkIndex()
    Dim sh As Worksheet 'Each sheet in workbook
    Dim rAll As Range 'All range in each sheet
    Dim rs As Range 'Each cell in rAll
    Dim rt As Range 'Last cell in sheet "All"
    Dim rtAll As Range 'Booking Index in sheet "All"
    For Each sh In Worksheets
        If sh.Name <> "All" Then
            Set rAll = sh.Range("C6", sh.Range("C" & Rows.Count).End(xlUp))
            For Each rs In rAll
                With Sheets("All")
                    Set rtAll = .Range("D8", .Range("D" & Rows.Count).End(xlUp))
                    Set rt = .Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
                End With
                If Application.CountIf(rtAll, rs) = 0 Then rt = rs.Value
            Next rs
        End If
    Next sh
End Sub

[prawitj]

ขอบคุณครับ ผมจะลองทำดูนะครับ

[prawitj]

ได้แล้วครับ แต่เกิดความโลภ แล้วถ้า ผมจะ เอา Data Column อื่นๆ มาแปะด้วยเลย ต้องเขียน Code ลักษณะยังไงครับ

[snasui]

ลองเขียนมาก่อนครับ ติดตรงไหนค่อยมาดูกันต่อครับ

[prawitj]

ลองละครับ ติดตั้งแต่เริ่ม พวก Code VBA นี่ผมไม่ค่อยถนัดเลยครับ

[prawitj]

ได้ละครับ ลองมั่วๆ ดู ได้เฉยเลยอย่างนี้ OK ไม๊ครับ

[prawitj]

ลองนี่ดีกว่าครับ ผมใส่ Loop ไว้เผื่อ จำนวน Column เปลี่ยน แต่ผมลอง ใส่ Code

intcount = rall.columns.count แล้วก็ วน Loop

for i =1 to intcount

rt.column(i) = rs.column(i)

next i

มัน ขึ้น แค่แถว Booking index แค่แถวเดียว ผมเลยใส่ ค่า Static เอาไว้ก่อน แต่อยากได้แบบ Dynamic รบกวนอาจารย์ช่วยแนะนำด้วยครับ

[snasui]

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

Code: Select all

Private Sub btnTransfer_Click()
    Dim sh As Worksheet 'Each sheet in workbook
    Dim rAll As Range 'All range in each sheet
    Dim rs As Range 'Each cell in rAll
    Dim rt As Range 'Last cell in sheet "All"
    Dim rtAll As Range 'Booking Index in sheet "All"
    Dim i As Integer 'Number of item.
    For Each sh In Worksheets
        If sh.Name <> "All" Then
            Set rAll = sh.Range("B6", sh.Range("B" & Rows.Count).End(xlUp))
            For Each rs In rAll
                With Sheets("All")
                    Set rtAll = .Range("D8", .Range("D" & Rows.Count).End(xlUp))
                    Set rt = .Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
                End With
                If Application.CountIf(rtAll, rs) = 0 Then
                    i = i + 1
                    rs.Resize(1, 5).Copy
                    rt.PasteSpecial xlPasteValues
                    rt.Offset(0, -1) = i
                End If
            Next rs
        End If
    Next sh
End Sub

[prawitj]

ถ้า เอา i ไว้ใน if มันก็จะนับให้เฉพาะตอน เข้าเงื่อนไขสิครับ แต่ถ้ามันเป็น index ที่เคยบันทึกไปแล้ว มันก็ข้ามเงื่อนไข อย่างนี้ น่าจะเอา i ไว้ข้างนอกปะครับ

[snasui]

อันนั้นก็แล้วแต่ประยุกต์ครับ Code ที่ผมเขียนให้นั้นตั้งใจให้เป็นตัวอย่าง สามารถปรับปรุงเปลี่ยนแปลงได้เต็มที่ครับ

กรณีต้องการใช้ i อยู่ทีเดิม สามารถปรับ Code ตรง

Code: Select all

i = i + 1

เป็น

Code: Select all

i = Val(rt.Offset(-1, -1)) + 1

หรือหากต้องการเอา i ออกไปเลยก็ย่อมได้ครับ โดยให้ลบ

Code: Select all

Dim i As Integer 'Number of item.

และลบ

Code: Select all

i = i + 1

ออกไป

แล้วแทนที่

Code: Select all

rt.Offset(0, -1) = i

ด้วย

Code: Select all

rt.Offset(0, -1) = Val(rt.Offset(-1, -1)) + 1