การดึงข้อมูลเฉพาะยอดรวมจากหลาย ๆ sheet มาไว้ในตาราง

[lumi]

สอบถามการนำข้อมูลจากหลาย ๆ sheet มารวมในตารางแต่ดึงมาเฉพาะยอดรวมแยก product และ currency
ตาม file แนบ โดยข้อมูลยอดรวมแต่ละรายไม่ได้เหมือนกันทุกครั้ง เช่น
เจ้าหนี้ 1 ราย ในรอบนี้อาจจะมี currency เดียว แต่รอบถัดไปอาจจะมี 2 currency ตามตัวอย่าง
หรือ เจ้าหนี้ 1 รายอาจจะซื้อทั้ง GOODS และ PARTS ซึ่งใน file แนบ Sheet Report เป็นผลลัพท์ที่ต้องการ
ซึ่งอยากได้เป็น Code vba ซึ่งลองเขียนเองแบบง่าย ๆ แล้วค่ะตามที่ส่งมา ได้ผลลัพท์ตามต้องการ แต่เมื่อมีรายการยอดรวมเปลี่ยนแปลง
ต้องไปแก้ไขเพิ่ม code เนื่องจากดึงมาไม่ครบ และ code ยาวมากถ้ามีจำนวนเจ้าหนี้มาก มีวิธีเขียนให้ง่ายกว่านี้มั้ยคะ

Code: Select all

Option Explicit
Dim k As Integer
Dim r As Integer

Private Sub CommandButton1_Click()
    r = 5
    For k = 2 To 5
    
'1010000000  KKK00
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "THB" Then
        Sheet1.Cells(5, 3) = Sheet2.Cells(k, 5)
    End If
    
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "JPY" Then
            Sheet1.Cells(6, 3) = Sheet2.Cells(k, 5)
            Sheet1.Cells(6, 4) = Sheet2.Cells(k, 4)
            Sheet1.Cells(6, 5) = Sheet2.Cells(k, 3)
    End If
    
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(5, 6) = Sheet2.Cells(k, 5)
        Sheet1.Cells(5, 7) = Sheet2.Cells(k, 4)
        Sheet1.Cells(5, 8) = Sheet2.Cells(k, 3)
    End If
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "USD" Then
        Sheet1.Cells(6, 6) = Sheet2.Cells(k, 5)
        Sheet1.Cells(6, 7) = Sheet2.Cells(k, 4)
        Sheet1.Cells(6, 8) = Sheet2.Cells(k, 3)
    End If
    
'1010000001 KKK01
    If Sheet3.Cells(k, 5) <> "" And Sheet3.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(7, 12) = Sheet3.Cells(2, 5) + Sheet13.Cells(8, 4)
    End If

'1010000010 KKK10
    If Sheet4.Cells(k, 5) <> "" And Sheet4.Cells(k, 2) = "PARTS" And Sheet4.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(10, 6) = Sheet4.Cells(k, 5)
        Sheet1.Cells(10, 7) = Sheet4.Cells(k, 4)
        Sheet1.Cells(10, 8) = Sheet4.Cells(k, 3)
    End If

'1010000011 KKK11
    If Sheet5.Cells(k, 5) <> "" And Sheet5.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(12, 12) = Sheet5.Cells(2, 5) + Sheet13.Cells(16, 4)
    End If


'1010000020 KKK20
    If Sheet6.Cells(k, 5) <> "" And Sheet6.Cells(k, 2) = "GOODS" And Sheet6.Cells(k, 4) = "JPY" Then
            Sheet1.Cells(15, 3) = Sheet6.Cells(k, 5)
            Sheet1.Cells(15, 4) = Sheet6.Cells(k, 4)
            Sheet1.Cells(15, 5) = Sheet6.Cells(k, 3)


'1010000030 KBT
    If Sheet7.Cells(k, 5) <> "" And Sheet7.Cells(k, 2) = "PARTS" And Sheet7.Cells(k, 4) = "USD" Then
        Sheet1.Cells(18, 6) = Sheet7.Cells(k, 5)
        Sheet1.Cells(18, 7) = Sheet7.Cells(k, 4)
        Sheet1.Cells(18, 8) = Sheet7.Cells(k, 3)
    End If
            
 '1010000031 KKK31
    If Sheet8.Cells(k, 5) <> "" And Sheet8.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(20, 12) = Sheet8.Cells(2, 5) + Sheet13.Cells(28, 4)
    End If
            
 '1010000051 KFI51
    If Sheet9.Cells(k, 5) <> "" And Sheet9.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(23, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(32, 4)
    End If
            
'1012070000 KMTC00
    If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "GOODS" And Sheet10.Cells(k, 4) = "THB" Then
            Sheet1.Cells(26, 3) = Sheet10.Cells(k, 5)
            
    If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "PARTS" And Sheet10.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(26, 6) = Sheet10.Cells(k, 5)
        Sheet1.Cells(26, 7) = Sheet10.Cells(k, 4)
        Sheet1.Cells(26, 8) = Sheet10.Cells(k, 3)
    End If
            
 '1012070001 KMTC01
    If Sheet11.Cells(k, 5) <> "" And Sheet11.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(28, 12) = Sheet11.Cells(2, 5) + Sheet13.Cells(40, 4)
    End If
            
 '1045010001 KSI01
    If Sheet12.Cells(k, 5) <> "" And Sheet12.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(31, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(44, 4)
    End If
r = r + 1
Next
End Sub

[menem]

ต้องขอโทษด้วยนะครับ ผมไม่ค่อยถนัด VBA เท่าไหร่ เลยลองเขียนมาในลักษณะของ
การใช้สูตรแทน , ซึ่งจะมีลักษณะที่เป็น Fixed ตำแหน่งข้อมูลในระดับหนึ่ง

สำหรับการแก้ไข VBA อาจจะต้องรอท่านอื่น ๆ ก่อนนะครับ

[DhitiBank]

ลองแบบนี้ครับ

Code: Select all

Public Sub TestTest()
    Dim rCode As Range, rEachComp As Range, r As Range, r1 As Range, _
        dCompCode As Double, sHt As Worksheet, _
        aRR() As Variant, iG%, iP%
    
    Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
    
    For Each sHt In ThisWorkbook.Sheets
        '~~> ตรวจชื่อชีท สนใจชีทที่ขึ้นต้นด้วย K
        If sHt.Name Like "K*" Then
            ReDim aRR(1 To 2, 1 To 10)
            With sHt
                dCompCode = .Range("a2").Value
                Set rEachComp = .Range("f2:f5")
            End With
            '~~~> สร้าง array
            iG = 1:     iP = 1
            aRR(1, 10) = 0
            For Each r In rEachComp
                If r.Value = "" Then Exit For
                Select Case UCase(r.Offset(, -4).Value)
                    Case Is = "GOODS"
                        aRR(iG, 1) = r.Offset(, -1).Value
                        If r.Value <> r.Offset(, -2).Value Then
                            aRR(iG, 2) = r.Offset(, -2).Value
                            aRR(iG, 3) = r.Offset(, -3).Value
                        End If
                        iG = iG + 1
                    Case Is = "PARTS"
                        aRR(iP, 4) = r.Offset(, -1).Value
                        If r.Value <> r.Offset(, -2).Value Then
                            aRR(iP, 5) = r.Offset(, -2).Value
                            aRR(iP, 6) = r.Offset(, -3).Value
                        End If
                        iP = iP + 1
                    Case Is = "OTHERS"
                        aRR(1, 10) = aRR(1, 10) + r.Offset(, -1).Value
                End Select
                '~~~> ตรวจชีทสุดท้าย ข้อมูลบันทึกไม่ทัน
                With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                        If r1.Value = dCompCode Then
                            aRR(1, 8) = r1.Offset(3, 3).Value
                        End If
                    Next r1
                End With
            Next r
            
            '~~~> ใส่ array ใน Report
            For Each r In rCode
                If r.Value = dCompCode Then
                    With r.Offset(, 2).Resize(2, 10)
                        .ClearContents
                        .Value = aRR
                    End With
                    r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
                                           + r.Offset(, 9).Value
                    r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
                                           + r.Offset(1, 9).Value
                    Exit For
                End If
            Next r
        End If
    Next sHt
End Sub

[lumi]

อยากรบกวนคุณ DhitiBank ช่วยอธิบายสูตรเพิ่มเติมอีกหน่อยได้มั้ยคะ ยังไม่ค่อยเก่งค่ะ
เลยอยากทำความเข้าใจก่อนนำมาปรับใช้กับงานจริงค่ะ ดูเองมาหลายวันแล้วแต่ก็ยังงง ๆ ค่ะ

[DhitiBank]

อยากให้ลองแกะโค้ด (เรียกโค้ดครับ) ดูด้วยตัวเองก่อนครับ เพราะคิดว่าจะเข้าใจมากกว่าผมอธิบายทีเดียวจบ แล้วพอเจอโค้ดไหนไม่เข้าใจจริงๆ ก็โพสต์ถามเป็นกรณีไป อยากแนะนำวิธีแกะโค้ดที่ผมใช้เป็นประจำครับ

1. ใช้ immediate window

2016-11-17 12_27_56-Microsoft Visual Basic for Applications - Book1 - [ThisWorkbook (Code)].png

อันนี้เป็นหน้าต่างที่ช่วยหาคำตอบของตัวแปรทุกตัวได้ หรือหาคำตอบโค้ดที่เรานึกได้ (แม้ว่าโค้ดนั้นไม่ได้อยู่ใน procedure ที่กำลังรันอยู่) และความสามารถอีกมาก การใช้งานก็ไม่ยุ่งยากครับ แค่พิมพ์เครื่องหมายคำถามก่อน ตามด้วยโค้ดที่เราต้องการหาคำตอบ
- เช่นในรูป เป็นการหาว่าชีทปัจจุบันชื่ออะไรก็คีย์ ?activesheet.name แล้ว enter
- ในกรณีโค้ดที่คุณกำลังแกะ ก็สามารถหาตัวแปร r ซึ่งเป็นประเภท range ได้ด้วย โดยคีย์ ?r.address ก็จะรู้ว่าตอนนี้ r คือเซลล์อะไร หรือตัวแปร sht คือชีทอะไร ?sht.name ทำนองนี้ครับ

2. การกด F8 เพื่อรันโค้ดทีละบรรทัด ช่วยให้เราดูทันว่าโค้ดทำงานอะไรบ้างครับ ขณะรัน เราสามารถเอาเม้าส์ชี้ที่ตัวแปรได้ (เช่น dcompcode หรืออื่นๆ) เพื่อดูค่าขณะนั้นๆ ได้ครับ

[lumi]

ขอบคุณมากค่ะลองแกะ code ตามที่บอกพอเข้าใจการทำงานแล้วค่ะ และกำลังปรับเข้ากับงานจริง
แต่ต้องไปแก้ไข sheet ย่อยทัั้งหมดให้ชื่อ sheet ขึ้นต้นเหมือนกัน และในงานจริงจะใช้ user form
เลยต้องเพิ่ม code เพื่อ activate sheet Report เข้าไปค่ะ จึงจะ run ผ่าน

สอบถามเพิ่มเติมค่ะ ถ้าข้อมูลจาก sheet ย่อยทั้งหมด เรียงอยู่ใน sheet เดียวกันทั้งหมดทุก vendor
เหมือนใน sheet Vendor_All ใน file ที่แนบ เวลาดึงไปวางใน sheet report จะต้องปรับสูตรอย่างไรคะ

[DhitiBank]

คงต้องเขียนโค้ดใหม่เลยครับ ลองเขียนมาเองดูก่อนครับ ติดปัญหาแล้วค่อยถามกันใหม่ คิดว่าคำสั่งเดิมๆ ก็เอามาปรับใช้ได้ครับ เพียงแต่ว่าแทนที่จะวนลูปทุกๆ ชีท ก็จะมาวนลูปในคอลัมน์ A และ B ในชีท Vendor_All ชีทเดียว

แนวคิดที่ผมคิดไว้ก็ทำนองนี้ครับ
-- วนลูปที่คอลัมน์ A หากพบข้อความ vendor ก็จะรู้ว่าลูกค้ารหัสอะไร จากนั้น
---- เริ่มวนลูปที่คอลัมน์ B สนใจเมื่อพบเครื่องหมาย * ก็จะเก็บข้อมูลเข้า array ได้ และสั่งให้หยุดลูปเมื่อเจอ **
------ เอารหัสลูกค้าที่ได้กับ array ข้อมูลที่สร้างไว้มาจัดการในชีท Report โดยวนลูปคอลัมน์ A ดูว่าเจอรหัสลูกค้าตรงกันเมื่อไร ก็เอา array ที่สร้างไว้มาวางครับ

[lumi]

ขอสอบถามเกี่ยวกับตัวแปรที่ใช้ค่ะ รบกวนช่วยอธิบายได้มั้ยคะยังไม่ค่อยเข้าใจค่ะ
aRR() As Variant, iG%, iP%
ReDim aRR(1 To 2, 1 To 10)

[DhitiBank]

aRR() as variant เป็นตัวแปรแบบอาร์เรย์ครับ ในที่นี้กำหนดให้เป็นประเภท variant คือเก็บข้อมูลได้หลายประเภท ทั้ง ตัวเลข ข้อความ ฯลฯ อาร์เรย์สามารถเก็บข้อมูลได้คล้ายๆ แผ่นงานใน excel (คือมีแถว มีคอลัมน์ และยังมีเชิงลึกอีก) จำค่าเอาไว้ในหน่วยความจำ สามารถเอาค่ามาใช้หรือเอามาวางในแผ่นงานได้เมื่อสั่ง สามารถทำงานได้รวดเร็วกว่าการคัดลอกมาวางในแผ่นงานทีละค่ามากๆ ครับ

iG กับ iP เป็นตัวแปรประเภท integer (ใช้สัญลักษณ์ % แทน as integer) ใช้เพื่อนับ Goods กับ Parts ของลูกค้าแต่ละรายครับ

Redim aRR(1 to 2, 1 to 10) เป็นคำสั่งที่กำหนดขนาดให้กับตัวแปรอาร์เรย์ ในกรณีนี้จะมี 2 แถว และ 10 คอลัมน์ครับ

ลองอ่านเพิ่มเติมที่ด้านล่างครับ
Data Type
Array variable
Redimension

[lumi]

ลองปรับ code เพื่อให้วนลูปในคอลัมน์ A และ B ในชีท Vendor_All ชีทเดียวตามที่คุณ DhitiBank แนะนำแล้ว
แต่พอกด run แล้วข้อมูลมันไม่มาไม่ทราบว่าทำอะไรผิดตรงไหนค่ะ โปรแกรมไม่แสดง error ค่ะ
ลองแก้อยู่นานแต่ไม่สำเร็จค่ะ

Code: Select all

Worksheets("REPORT").Activate
Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
For k = 1 To lngLastRow
        If Sheets("Vendor_All").Cells(k, 2) = "*" Then
            ReDim aRR(1 To 2, 1 To 10)
            StrVendorCode = Trim(Sheets("Vendor_All").Cells(k, 13))
            rCurr = Trim(Sheets("Vendor_All").Cells(k, 11))
            rPrd = Trim(Sheets("Vendor_All").Cells(k, 7))
            
            iG = 1:     iP = 1
            aRR(1, 10) = 0
                Select Case rPrd
                    Case Is = "GOODS"
                        aRR(iG, 1) = Trim(Sheets("Vendor_All").Cells(k, 10))
                        If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
                            aRR(iG, 2) = Trim(Sheets("Vendor_All").Cells(k, 9))
                            aRR(iG, 3) = Trim(Sheets("Vendor_All").Cells(k, 8))
                        End If
                       iG = iG + 1
                    Case Is = "PARTS"
                        aRR(iP, 4) = Trim(Sheets("Vendor_All").Cells(k, 10))
                        If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
                            aRR(iP, 5) = Trim(Sheets("Vendor_All").Cells(k, 9))
                            aRR(iP, 6) = Trim(Sheets("Vendor_All").Cells(k, 8))
                        End If
                        iP = iP + 1
                    Case Is = "OTHERS"
                        aRR(1, 10) = Trim(Sheets("Vendor_All").Cells(k, 10))
                End Select
            End If
        Next k
    
        Worksheets("REPORT").Activate
            For r = 1 To 200
                If Sheets("REPORT").Cells(r, 1) = StrVendorCode Then
                    With r.Offset(, 2).Resize(2, 10)
                        .ClearContents
                        .Value = aRR
                    End With
                    r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
                                           + r.Offset(, 9).Value
                    r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
                                           + r.Offset(1, 9).Value
                    Exit For
                End If
            Next r
End Sub

[DhitiBank]

ขอโทษทีครับ ตอนนี้ผมไม่มีคอมฯ กับตัว หากยังไม่ได้รับคำตอบ ผมจะช่วยดูให้ตอนเย็นๆ นะครับ

แตเท่าที่ดูโค้ด คิดว่ายังลูปไม่ถูกครับ การลูปในชีท vendor_all น่าจะ
1. เริ่มลูปจากคอลัมน์ A ~~> พบเซลล์ที่มีคำว่า vendor ~~> ได้รหัส vendor ที่อยู่แถวเกียวกัน ~~> redim ตัวแปรอาร์เรย์ ~~> เริ่มลูปที่สอง
2. ลูปคอลัมน์ B จากแถวเดียวกับที่พบคำว่า vendor ในคอลัมน์ A โดนสนใจเซลล์ที่มี * ก็ให้เอาค่าที่สนใจในแถวเดียวกันเข้าอาร์เรย์ ~~> หยุดลูปที่สองเมื่อเจอ **

จากนั้นก็เอารหัส vendor กับอาร์เรย์ที่ได้ไปลูปในชีท report เพื่อวางค่า แล้วก็เริ่มลูปที่ 1 ~> 2 ใหม่ครับ วนจนหมดข้อมูลในชีท vendor_all ครับ

[DhitiBank]

ลองแบบนี้ครับ

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r2 As Range, rCode As Range, rVendor As Range
    Dim StrVendorCode As Double
    Dim aRR() As Variant, iG%, iP%
    Dim k As Long, lngLastRow As Long
    
    lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    For Each r In rCode
        r.Offset(, 2).Resize(2, 10).ClearContents
    Next r
    
    With Sheets("vendor_all")
        Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
        '~~> ลูปแรก คอลัมน์ A หาคำว่า vendor
        For Each r In rVendor
            If InStr(r.Value, "Vendor") > 0 Then
                StrVendorCode = r.Offset(, 5).Value
                ReDim aRR(1 To 2, 1 To 10)
                iG = 1:     iP = 1
                
                '~~> ลูปสอง คอลัมน์ B หา '*'
                For k = r.Row To lngLastRow
                    If .Cells(k, "b").Value = "**" Then Exit For
                    If .Cells(k, "b").Value = "*" Then
                        Select Case UCase(Trim(.Cells(k, "g").Value))
                            Case Is = "GOODS"
                                aRR(iG, 1) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iG, 2) = .Cells(k, "i").Value
                                    aRR(iG, 3) = .Cells(k, "h").Value
                                End If
                                iG = iG + 1
                            Case Is = "PARTS"
                                aRR(iP, 4) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iP, 5) = .Cells(k, "i").Value
                                    aRR(iP, 6) = .Cells(k, "h").Value
                                End If
                                iP = iP + 1
                            Case Is = "OTHERS"
                                aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
                        End Select
                    End If
                Next k
                
                aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
                aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
                
                '~~> ลูปสาม หารหัสเดียวกันในชีท report
                For Each r2 In rCode
                    If r2.Value = StrVendorCode Then
                        r2.Offset(, 2).Resize(2, 10).Value = aRR
                    End If
                Next r2
            End If
        Next r
    End With
End Sub

[lumi]

ทำได้แล้วค่ะขอบคุณมาก ๆ นะคะ ได้ความรู้อีกเยอะเลยค่ะ

[lumi]

มีคำถามเพิ่มเติมค่ะจากโจทย์เดิมลองทำแล้ว run ได้ แต่เมื่อเพิ่ม sheet : GR-IR 211101000 เข้าไปแล้วจะดึงยอดมารวมกัน
ใน Sheet : Report ปรากฎว่ายอดมารวมไม่ถูกบรรทัดในช่อง GOODS/FG และ PARTS/SP ค่ะ และ เจ้าหนี้รายสุดท้ายข้อมูลก็ไม่มาค่ะ ไม่แน่ใจว่า code ผิดตรงไหน Loop 4 ข้อมูลมาถูกต้อง แต่พอ Loop 5 ข้อมูลเริ่มผิดค่ะ ใน file excel ตัวเลขแถบสีชมพูเป็นตัวเลขที่ถูกต้องค่ะ รบกวนอีกครั้งนะคะ
ขอบคุณค่ะ

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r1 As Range, r2 As Range, r3 As Range, rCode As Range, rVendor As Range
    Dim StrVendorCode As Double
    Dim aRR() As Variant, iG%, iP%
    Dim k, k1 As Long, lngLastRow As Long
       
    lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    For Each r In rCode
    
        r.Offset(, 2).Resize(2, 10).ClearContents
    Next r
    
    With Sheets("vendor_all")
        Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
        '~~> Loop 1 คอลัมน์ A หาคำว่า vendor
        For Each r In rVendor
            If InStr(r.Value, "Vendor") > 0 Then
                StrVendorCode = r.Offset(, 5).Value
                ReDim aRR(1 To 2, 1 To 10)
                iG = 1:     iP = 1
                
                '~~> Loop 2 คอลัมน์ B หา '*'
                For k = r.Row To lngLastRow
                    If .Cells(k, "b").Value = "**" Then Exit For
                    If .Cells(k, "b").Value = "*" Then
                        Select Case UCase(Trim(.Cells(k, "g").Value))
                            Case Is = "GOODS"
                                aRR(iG, 1) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iG, 2) = .Cells(k, "i").Value
                                    aRR(iG, 3) = .Cells(k, "h").Value
                                End If
                                iG = iG + 1
                            Case Is = "PARTS"
                                aRR(iP, 4) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iP, 5) = .Cells(k, "i").Value
                                    aRR(iP, 6) = .Cells(k, "h").Value
                                End If
                                iP = iP + 1
                            Case Is = "OTHERS"
                                aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
                        End Select
                        
                '--> Loop 3 ตรวจข้อมูล Sheet รายการบันทึกไม่ทัน
                    With Sheets("ข้อมูลบันทึกไม่ทัน")
                        For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                            If r1.Value = StrVendorCode Then
                                aRR(1, 8) = r1.Offset(3, 3).Value
                            End If
                        Next r1
                    End With
                End If
            Next k
             
            '--> Loop 4 ตรวจข้อมูล Sheet Accrued
                    With Sheets("Accrued 240399005")
                        For Each r3 In .Range("s:s").SpecialCells(xlCellTypeConstants)
                            If r3.Value = StrVendorCode Then
                                 aRR(1, 10) = aRR(1, 10) + r3.Offset(0, 4).Value
                            End If
                        Next r3
                    End With
                    
            '--> Loop 5 ข้อมูล Sheet GR-IR 211101000
                    With Sheets("GR-IR 211101000")
                        For k1 = 9 To 28
                            If .Cells(k1, "ar").Value = "" Then Exit For
                            If .Cells(k1, "ar").Value = StrVendorCode Then
                            iG = 1:     iP = 1

                                Select Case UCase(Trim(.Cells(k1, "as").Value))
                                    Case Is = "FG"
                                        aRR(iG, 1) = aRR(iG, 1) + .Cells(k1, "av").Value
                                            If .Cells(k1, "au") <> .Cells(k1, "av") Then
                                                aRR(iG, 2) = .Cells(k1, "at").Value
                                                aRR(iG, 3) = aRR(iG, 3) + .Cells(k1, "au").Value
                                            End If
                                        iG = iG + 1
                                    Case Is = "SP"
                                        aRR(iP, 4) = aRR(iP, 4) + .Cells(k1, "av").Value
                                            If .Cells(k1, "au") <> .Cells(k1, "av") Then
                                                aRR(iP, 5) = .Cells(k1, "at").Value
                                                aRR(iP, 6) = aRR(iP, 6) + .Cells(k1, "au").Value
                                            End If
                                        iP = iP + 1
                                End Select
                            End If
                        Next k1
                    End With
                        
                
                aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
                aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
                
                '~~> Loop 6 หารหัสเดียวกันใน Sheet report
                For Each r2 In rCode
                    If r2.Value = StrVendorCode Then
                        r2.Offset(, 2).Resize(2, 10).Value = aRR
                    End If
                Next r2
            End If
        Next r
    End With
End Sub

[DhitiBank]

งงครับ ข้อมูลชีท Accrued กับ GR-IR ต้องเอามาทำอะไรกับชีท Vendor_all ครับ

1. ตัวอย่างลูกค้า KKK (OSAKA) ในชีท vendor_all มี Goods จำนวน 2 แถว และมีลูกค้ารายนี้ในชีท GR-IR ด้วย (คิดว่า "FG" ในคอลัมน์ AS คือประเภท Goods ใช่ไหมครับ) ซึ่งมี FG 2 รายการเช่นกัน ข้อมูล 2 ชีทนี้จะต้องเอามาอะไรกันครับ

2. อธิบายการจัดการข้อมูลในชีท Accrued ด้วยครับ

[lumi]

ขอโทษนะคะที่อาจจะอธิบายไปไม่ละเอียดค่ะ คือยอดที่แสดงใน Sheet Report จะมาจากตัวเลขใน 3 Sheet รวมกันค่ะ คือ
1. Sheet : Vendor_All ซึ่งจะแยกยอด sum เป็น GOODS, PARTS และ OTHERS
2. Sheet : GR-IR 211101000 ซึ่งจะแยกยอด sum เป็น FG กับ SP โดย FG คือประเภท GOODS และ SP คือประเภท PARTS
3. Sheet : Accrued 240399005 เป็นข้อมูลที่ไปบวกกับยอด OTHERS (โดยใช้ข้อมูลจาก Column S ถึง Y จากตัวอย่างข้อมูลจะเริ่ม
ที่บรรทัดที่ 8

ตัวอย่าง ลูกค้า KKK (OSAKA) รหัส 1010000000
ในชีท vendor_all มี Goods จำนวน 2 แถว
GOODS 1,200,000 JPY 420,000.00 THB
GOODS 58,500 THB 58,500.00 THB

ในชีท GR-IR 211101000 มี FG 2 แถว ก็คือประเภท GOODS
1010000000 FG JPY 100,000.00 33,000.00
1010000000 FG THB 20,000.00 20,000.00

ใน sheet Report ยอดที่แสดงถ้าเป็นสกุลเงินเดียวกันจะรวมอยู่บรรทัดเดียวกัน (1 Vendor ไม่เกิน 2 สกุลเงิน)
ดังนั้น ลูกค้า KKK (OSAKA) รหัส 1010000000
ยอดที่ปรากฎใน Sheet Report ช่อง GOODS/FG คือ

THB Currency
453,000 JPY 1,300,000
78,500
------------------------------------------------------------------------------------------------------
สำหรับ PARTS ก็เหมือนกันค่ะ เช่น
ตัวอย่าง ลูกค้า KKK (OSAKA) รหัส 1010000000
ในชีท vendor_all มี Parts จำนวน 1 แถว
[background=]PARTS 194,324 JPY 68,013.40 THB
[/background]
ในชีท GR-IR 211101000 มี SP 2 แถว ก็คือประเภท PARTS
1010000000 SP THB 20,607,288.00 20,607,288.00
1010000000 SP JPY 10,000.00 3,300.00

ดังนั้น ลูกค้า KKK (OSAKA) รหัส 1010000000
ยอดที่ปรากฎใน Sheet Report ช่อง PARTS/SP คือ

THB Currency
71,313.40 JPY 204,324
20,607,288.00
----------------------------------------------------------------------------------
สำหรับข้อมูลใน Sheet Accrued 240399005 จะนำเงินบาทใน คอลัมน์ W มาบวกกับ
เงินบาทใน Sheet Vendor_All และแสดงยอดในช่อง OTHERS ตามรหัส vendor ค่ะ

[DhitiBank]

ลองแบบนี้ครับ

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r1 As Range, r2 As Range, rTemp As Range, _
        rCode As Range, rVendor As Range
    Dim dVendorCode As Double
    Dim aRR() As Variant, iG%, iP%, k%
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    
    '~~> 1st Loop for each vendor code in REPORT
    For Each r In rCode
        dVendorCode = r.Value
        With Sheets("vendor_all")
            Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
            
            '~~> 2nd Loop for finding the row this vendor is
            For Each r1 In rVendor
                If InStr(r1.Value, "Vendor") > 0 Then
                    ReDim aRR(1 To 2, 1 To 10)
                    iG = 1:         iP = 1
                    If r1.Offset(, 5).Value = dVendorCode Then
                        Set rTemp = .Range("b" & r1.Row).Resize(200, 1).SpecialCells(xlCellTypeConstants)
                        
                        '~~> 3rd Loop for collecting this vendor's data
                        For Each r2 In rTemp
                            If r2.Value = "**" Then Exit For
                            If r2.Value = "*" Then
                                Select Case Trim(r2.Offset(, 5).Value)
                                    Case Is = "GOODS"
                                        aRR(iG, 1) = r2.Offset(, 8).Value
                                        If r2.Offset(, 7) <> r2.Offset(, 9) Then
                                            aRR(iG, 2) = r2.Offset(, 7).Value
                                            aRR(iG, 3) = r2.Offset(, 6).Value
                                        End If
                                        iG = iG + 1
                                    Case Is = "PARTS"
                                        aRR(iP, 4) = r2.Offset(, 8).Value
                                        If r2.Offset(, 7) <> r2.Offset(, 9) Then
                                            aRR(iP, 5) = r2.Offset(, 7).Value
                                            aRR(iP, 6) = r2.Offset(, 6).Value
                                        End If
                                        iP = iP + 1
                                    Case Is = "OTHERS"
                                        aRR(1, 10) = aRR(1, 10) + r2.Offset(, 8).Value
                                End Select
                            End If
                        Next r2
                        Exit For
                    End If
                End If
            Next r1
        End With
        
        '~~> 4th
        With Sheets("ข้อมูลบันทึกไม่ทัน")
            For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    aRR(1, 8) = r1.Offset(3, 3).Value
                    Exit For
                End If
            Next r1
        End With
        
        '~~> 5th
        With Sheets("GR-IR 211101000")
            For Each r1 In .Range("ar:ar").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    For k = 1 To 2
                        Select Case r1.Offset(, 1).Value
                            Case Is = "FG"
                                If aRR(k, 2) = r1.Offset(, 2).Value Or _
                                    (IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
                                    aRR(k, 1) = aRR(k, 1) + r1.Offset(, 4).Value
                                    If r1.Offset(, 4) <> r1.Offset(, 3) Then _
                                        aRR(k, 3) = aRR(k, 3) + r1.Offset(, 3).Value
                                    Exit For
                                End If
                            Case Is = "SP"
                                If aRR(k, 2) = r1.Offset(, 2).Value Or _
                                    (IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
                                    aRR(k, 4) = aRR(k, 4) + r1.Offset(, 4).Value
                                    If r1.Offset(, 4) <> r1.Offset(, 3) Then _
                                        aRR(k, 6) = aRR(k, 6) + r1.Offset(, 3).Value
                                    Exit For
                                End If
                        End Select
                    Next k
                End If
            Next r1
        End With
        
        '~~> 6th
        With Sheets("Accrued 240399005")
            For Each r1 In .Range("s:s").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    aRR(1, 10) = aRR(1, 10) + r1.Offset(, 4).Value
                End If
            Next r1
        End With
        
        r.Offset(, 2).Resize(2, 10).ClearContents
        r.Offset(, 2).Resize(2, 10).Value = aRR
    Next r
End Sub

[lumi]

ลองทำดูแล้วปรับกับข้อมูลจริงนิดหน่อยได้แล้วค่ะ ขอบคุณมากนะคะ