เงื่อนไขการเปรียบเทียบข้อมูลที่ตรงกันแล้วนำมาแสดง

[hutthaya]

หนูมีแนวการคิดแต่เขียนออกมาไม่เป็นค่ะ
หนูต้องการนำข้อมูลจาก sheet : summary1 มาเปรียบเทียบกับข้อมูลที่มีการ insert เข้ามาอัตโนมัติใน sheet : data template ให้ตรงตามเงื่อนไขคือ
check ข้อมูลที่ตรงกันในแนว row ก่อน คือ ที่ sheet : summary ถ้า ชื่อ product กับ capacity ตรงกับ ชื่อ family ละ capacity ของ sheet : mps template ถ้าตรงให้ทำการเชคในแนวคอลัมน์คือ
ที่คอลัมน์ FMONTH : เดือนในแนวคอลัมน์ของแถวนั้นตรงกับเดือนที่อยุ่ใน mps template หรือที่เซล (6,3) หรือไม่ ถ้าตรงให้แสดงค่าจาก sheet : summary1 ที่คอลัมน์ summary มาไว้ในใน sheet: mps template ให้ตรงตามชื่อ product,capacity,และเดือน เมื่อจบชื่อ product หนึ่งก็จะมีการ คำนวณบวกค่าของ summary ของ product นั้นไว้ที่ส่วนของ sub total เสมอ ในส่วนของ summary2 ก็นำมาเทียบกับ sheet : mps template เช่นเดียวกันค่ะ แต่ข้อมูลของ summary จะมาปรากฏอยุ่ในส่วนของ sheet: mps templat ตั้งแต่ คอลัมน์ G-J ค่ะ และจะนำข้อมูลทั้ง 2 mps มาทำการเปรียบเทียบค่าที่ต่างกันใน sheet : mps template ตั้งแต่คอลัมน์


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

Code: Select all

Option Explicit
Dim grandTotal As Double
Public Function compareprocap()
              ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
                        Dim rAll As Range, r As Range
                        Dim colR As Collection, item As Variant
                        Dim subTotal As Double, target As Range
                        Dim iMax As Integer, iCount As Integer
                        Set colR = New Collection
                        Dim grandTotal As Double
                            grandTotal = 0
                        With Sheets("NEWDATA")
                            Set rAll = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
                        End With
                        On Error Resume Next
                        
                        For Each r In rAll   ' loop for add
                            colR.Add r, r 'row number null
                        Next r
                        On Error GoTo 0   'debug error
                        
                        For Each item In colR
                            iMax = Application.CountIf(rAll, item)
                            iCount = 0
                            subTotal = 0
                            For Each r In rAll
                                If r <> "" Then
                                    With Sheets("MPS TEMPLATE")
                                        Set target = .Range("a" & Range("a99999").End(xlUp).Row).Offset(1, 0) 'set target
                                    End With
                                    
                                    If r = item Then
                                        Rows(target.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'insert row
                                        
                                        target.Offset(-1, 0) = r
                                        target.Offset(-1, 0).Offset(0, 1) = r.Offset(0, 1) 'count colum capacity
                                    
                                        subTotal = subTotal + r.Offset(0, 1)
                                        iCount = iCount + 1
                                    End If
                                    If iCount = iMax Then
                                        Rows(target.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'insert row
                                        
                                        With Sheets("MPS TEMPLATE").Range("a" & Range("a99999").End(xlUp).Row)
                                            .Offset(1, 0) = "Sub Total"
                                            .Offset(1, 1).Font.Color = -10477568
                                            .Offset(1, 1).Font.Bold = True
                                            grandTotal = grandTotal
                                            subTotal = 0
                                        End With
                                        With Sheets("MPS TEMPLATE")
                                            Range("a" & target.Row - 1 & ":n" & target.Row - 1).Interior.Color = 13434777
                                        End With
                                        Exit For
                                    Else
                                    End If
                                End If
                             Next r
                             grandTotal = grandTotal
                        Next item
                        With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
                            .Offset(1, 0) = "Grand Total"
                    
                            .Offset(1, 1).Font.Color = 15773696
                            .Offset(1, 1).Font.Bold = True
                        End With
                        With Sheets("MPS TEMPLATE")
                            Range("a" & target.Row & ":n" & target.Row).Interior.Color = 49407
                        End With
End Function

ขอบคุณค่ะ

[snasui]

มาตอบเป็นเบื้องต้น

Code VBA จะต้องเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน ติดตรงไหนแล้วค่อยถามกัน หมายถึงเขียนตามหลักการคิดแล้วติดปัญหาแล้วค่อยถาม เนื่องจากการใช้ VBA จำเป็นต้องศึกษามาเป็นลำดับ การที่ผู้ตอบเขียนให้ก่อนถือว่ากระทำผิดกฎครับ

สำหรับ Code ที่แนบมานี้เป็น Sub Procedure ไม่ใช่ Function Procedure จะอยู่ใน Form

Code: Select all

Public Sub compareprocap()
...
End Sub

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

[hutthaya]

คือหนูไม่เข้าใจการทำงานของโค้ดนี้เลยค่ะเข้าใจแค่บางส่วนไม่เข้าใจเกี่ยวกับการวน for ค่ะอาจาร์ยลองรันทีละสเตอแต่ก็ยังงงกับการเก็บค่าของตัวแปรค่ะ

Code: Select all

Dim grandTotal As Double
Public Function compareprocap()
              ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
                        Dim rAll As Range, r As Range
                        Dim colR As Collection, item As Variant
                        Dim subTotal As Double, target As Range
                        Dim iMax As Integer, iCount As Integer
                        Set colR = New Collection
                        Dim grandTotal As Double
                            grandTotal = 0
                        With Sheets("NEWDATA")
                            Set rAll = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
                        End With
                        On Error Resume Next
                        For Each r In rAll
                            colR.Add r, r                        Next r
                        On Error GoTo 0                           
                        For Each item In colR
                            iMax = Application.CountIf(rAll, item)
                            iCount = 0
                            subTotal = 0
                            For Each r In rAll
                                If r <> "" Then
                                    With Sheets("MPS TEMPLATE")
                                        Set target = .Range("a" & Range("a99999").End(xlUp).row).Offset(1, 0)                                 
    End With
                                    
                                    If r = item Then
                                        Rows(target.row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow                                         
                                        target.Offset(-1, 0) = r
                                        target.Offset(-1, 0).Offset(0, 1) = r.Offset(0, 1) 'count colum capacity
                                        
                                        subTotal = subTotal + r.Offset(0, 1)
                                        iCount = iCount + 1
                                    End If
                                    If iCount = iMax Then
                                        Rows(target.row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'insert row
                                        
                                        With Sheets("MPS TEMPLATE").Range("a" & Range("a99999").End(xlUp).row)
                                            .Offset(1, 0) = "Sub Total"
                                            .Offset(1, 1).Font.Color = -10477568
                                            .Offset(1, 1).Font.Bold = True
                                            grandTotal = grandTotal
                                            subTotal = 0
                                        End With
                                        With Sheets("MPS TEMPLATE")
                                            Range("a" & target.row - 1 & ":n" & target.row - 1).Interior.Color = 13434777
                                        End With
                                        Exit For
                                    Else
                                    End If
                                End If
                             Next r
                             grandTotal = grandTotal
                        Next item
                        With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
                            .Offset(1, 0) = "Grand Total"
                    
                            .Offset(1, 1).Font.Color = 15773696
                            .Offset(1, 1).Font.Bold = True
                        End With
                        With Sheets("MPS TEMPLATE")
                            Range("a" & target.row & ":n" & target.row).Interior.Color = 49407
                        End With
End Function

[snasui]

ค่อย ๆ ถามตอบกันไปครับ หลักการของ For...Next ศึกษาตามนี้ครับ For...Next

สำหรับ Code ที่ถามมา ผมขอแจ้งอีกรอบให้เปลี่ยนจาก Function เป็น Sub เพราะไม่ได้ทำงานอย่างเช่น Function ครับ

หากศึกษาแล้วไม่เข้าใจส่วนใดควรยกมาถามเฉพาะส่วนนั้นครับ

[hutthaya]

comparemps.xlsm

Code: Select all

Public Function compareFmonth1mps1() 'Fmonth1mps1
Dim i, j, x As Integer
Dim Fmonth() As String
Dim pro As String
Dim cap As String
Dim pro2() As String
Dim cap2() As String
Dim commit() As String
Dim no_c, no_d As Single

    i = 1
    no_c = 0
    Do Until Worksheets("summary1").Cells(i + 1, 1).Value & Worksheets("summary1").Cells(i + 1, 2).Value = ""
        
        i = i + 1
        no_c = no_c + 1
        
    Loop
    i = 1
     no_d = 0
    Do Until Worksheets("MPS TEMPLATE").Cells(i + 6, 1).Value & Worksheets("MPS TEMPLATE").Cells(i + 6, 2).Value = ""
        
        i = i + 1
        no_d = no_d + 1
        
    Loop
ReDim pro2(1 To no_d)
ReDim cap2(1 To no_d)
ReDim Fmonth(1 To no_c)
ReDim commit(1 To no_c)
i = 1
    For i = 1 To no_d
    ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
       pro2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 1).Value
       cap2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 2).Value
Next i
i = 1
    For i = 1 To no_c
    
       pro = Worksheets("summary1").Cells(i + 1, 1).Value
       cap = Worksheets("summary1").Cells(i + 1, 2).Value
       Fmonth(i) = Worksheets("summary1").Cells(i + 1, 3).Value
       commit(i) = Worksheets("summary1").Cells(i + 1, 5).Value
      
    
   j = 1
  For j = 1 To no_d
   
     If (Fmonth(i) = Worksheets("MPS TEMPLATE").Cells(6, 3).Value) And (pro = pro2(j)) And (cap = cap2(j)) Then
       
        
        Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = commit(i)
        x = 1
   Exit For
 
   
        
   Else
   

     x = 0
   
     End If
    Next j
    

    Next i
    
    
   
  
End Function

เขียนดึงมาเทียบและแสดงได้แล้วค่ะอาจาร์ยแต่ติดที่จะคำนวณต่อค่ะ คือถ้าจบชื่อ product หนึ่งที่แถว "sub total" จะคำนวณบวกค่าของแต่ละproduct ค่ะ ส่วน "gran total" จำคำนวณยอดรวมของ sub total ทั้งหมดค่ะ

[snasui]

ช่วยแจ้งว่าติดขัดที่บรรทัดใด คำตอบที่ได้คืออะไร ที่ถูกต้องจะต้องเป็นค่าใดครับ

สำหรับ Code ที่เขียนมาผมย้ำเป็นครั้งที่สามว่าเป็น Sub Procedure ไม่ใช่ Function Procedure ควรเปลี่ยนให้ถูกต้อง ผู้ตอบจะได้ไม่เข้าใจผิดถึงหน้าที่ของ Procedure ครับ

สำหรับการประกาศตัวแปรใน VBA ใช้การประกาศเหมือน VB ไม่ได้ ยกตัวอย่างเช่น

Code: Select all

Dim i, j, x As Integer

จาก Code ที่ยกมา x เท่านั้นที่เป็น Integer ส่วนตัวอื่น ๆ เป็น Variant ถ้าจะให้เป็น Integer ทั้งหมดจะต้องประกาศเป็นด้านล่างครับ

Code: Select all

Dim i as integer, j as integer, x As Integer

[hutthaya]

1. เมื่อรันโปรแกรมแล้วจะเห็นว่ามีส่วนที่ว่างไว้ค่ะอยากให้เซลที่ว่างไว้ที่ไม่มีในsheet :summary ที่ดึงมามีค่าเป็น 0 ค่ะ
เช่น ARCUSPL4600 จะไม่ตรงตามเงื่อนไขค่าที่แสดงในคอลัมน์ที่ 3 จึงออกมาว่างค่ะ อยากให้แสดงเป็นค่า 0 เพื่อจะนำไปใช้ในการ sum

2. ที่ sheet :MPS TEMPLATE ที่ระบายสีชมพูไว้คืออยากให้ผลลัพธ์ออกมาแบบนั้นค่ะ แสดงผลลัพธ์การบวกเมื่อจบชื่อโปรดัคหนึ่งๆค่ะในแถวที่ตรงกับ "sub total"ค่ะ

comparemps.xlsm

Code: Select all

Public Sub sumcommit() 'Fmonth1mps1
Dim i As Integer, j As Integer, x As Integer
Dim Fmonth() As String
Dim pro As String
Dim cap As String
Dim pro2() As String
Dim cap2() As String
Dim commit() As String
Dim no_c As Single, no_d As Single

    i = 1
    no_c = 0
    Do Until Worksheets("summary1").Cells(i + 1, 1).Value & Worksheets("summary1").Cells(i + 1, 2).Value = ""
        
        i = i + 1
        no_c = no_c + 1
        
    Loop
    i = 1
     no_d = 0
    Do Until Worksheets("MPS TEMPLATE").Cells(i + 6, 1).Value & Worksheets("MPS TEMPLATE").Cells(i + 6, 2).Value = ""
        
        i = i + 1
        no_d = no_d + 1
        
    Loop
ReDim pro2(1 To no_d)
ReDim cap2(1 To no_d)
ReDim Fmonth(1 To no_c)
ReDim commit(1 To no_c)
i = 1
    For i = 1 To no_d
    ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
       pro2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 1).Value
       cap2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 2).Value
Next i
i = 1
    For i = 1 To no_c
    
       pro = Worksheets("summary1").Cells(i + 1, 1).Value
       cap = Worksheets("summary1").Cells(i + 1, 2).Value
       Fmonth(i) = Worksheets("summary1").Cells(i + 1, 3).Value
       commit(i) = Worksheets("summary1").Cells(i + 1, 5).Value
      
    
   j = 1
  For j = 1 To no_d
   
     If (Fmonth(i) = Worksheets("MPS TEMPLATE").Cells(6, 3).Value) And (pro = pro2(j)) And (cap = cap2(j)) Then
       
        
        Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = commit(i)
        x = 1
   Exit For
 
   
        
   Else
   

     x = 0
   
     End If
    Next j
    

    Next i
    
    
End Sub

[snasui]

ตัวอย่าง Code ด้านล่าง สำหรับการใส่ 0 และ Subtotal หลังจาก Run Code ที่แนบมาแล้ว ลองปรับใช้ดูครับ

Code: Select all

Sub Test00()
    Dim rAll As Range
    Dim r As Range
    Dim subTotal As Double
    Dim grandToal As Double
    With Sheets("MPS TEMPLATE")
        Set rAll = .Range("a7", .Range("a" & .Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        If InStr(r.Value, "Sub Total") = 0 Then
            If r.Offset(0, 2) = "" Then
                r.Offset(0, 2) = 0
            Else
                subTotal = subTotal + r.Offset(0, 2)
            End If
        ElseIf InStr(r.Value, "Sub Total") > 0 Then
            r.Offset(0, 2) = subTotal
            grandTotal = grandTotal + subTotal
            subTotal = 0
        End If
        If InStr(r.Value, "Grand Total") > 0 Then
            r.Offset(0, 2) = grandTotal
        End If
    Next r
End Sub

[hutthaya]

ขอบคุณค่ะ
ได้แล้วค่ะอาจาร์ยหนูลองเขียนใช้ for..next เช็คค่ะ
แต่ตอนนี้คือหนูอยากให้ sum ไปด้านขวารวมค่าของทุกเดือนที่ชื่อโปรดัคนั้นไว้ที่คอลัมน์ F ที่เซล (6+j,6) ค่ะ หนูค่อนข้างใช้เวลาการเขียนนาเพราะไม่ค่อยเข้าใจเกี่ยวกับการอ้างอิงตำแหน่งแบบใช้ .offset เลยค่ะ เลยใช้การอ้างอิงตำแหน่งแบบ .cells

Code: Select all

Public Function comparefmonth1mps1()
Dim i As Integer, x As Integer, j As Integer
Dim Fmonth() As String
Dim pro As String
Dim cap As String
Dim pro2() As String
Dim cap2() As String
Dim commit() As String
Dim no_c As Single, no_d As Single, sum As Single, total As Single


    i = 1
    no_c = 0
    Do Until Worksheets("summary1").Cells(i + 1, 1).Value & Worksheets("summary1").Cells(i + 1, 2).Value = ""
        
        i = i + 1
        no_c = no_c + 1
        
    Loop
    i = 1
     no_d = 0
    Do Until Worksheets("MPS TEMPLATE").Cells(i + 6, 1).Value & Worksheets("MPS TEMPLATE").Cells(i + 6, 2).Value = ""
        
        i = i + 1
        no_d = no_d + 1
        
    Loop
ReDim pro2(1 To no_d)
ReDim cap2(1 To no_d)
ReDim Fmonth(1 To no_c)
ReDim commit(1 To no_c)
i = 1
    For i = 1 To no_d ' collection with array sheet : mps template
       pro2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 1).Value
       cap2(i) = Worksheets("MPS TEMPLATE").Cells(6 + i, 2).Value
Next i
i = 1
    For i = 1 To no_c
      
       pro = Worksheets("summary1").Cells(i + 1, 1).Value
       cap = Worksheets("summary1").Cells(i + 1, 2).Value
       Fmonth(i) = Worksheets("summary1").Cells(i + 1, 3).Value
       commit(i) = Worksheets("summary1").Cells(i + 1, 5).Value
      
      ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
   j = 1
  For j = 1 To no_d  'check month and procap
  
     If (Fmonth(i) = Worksheets("MPS TEMPLATE").Cells(6, 3).Value) And (pro = pro2(j)) And (cap = cap2(j)) Then
        Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = commit(i)
        
        x = 1
        Exit For
   Else
     x = 0
     
     End If
    Next j
    Next i
    
    sum = 0
    total = 0
      For j = 1 To no_d  'sum commit sub total
      If pro2(j) <> "Sub Total" Then
        sum = sum + Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value
       sum = sum + Worksheets("MPS TEMPLATE").Cells(6 + j, 6).Value
      ElseIf pro2(j) = "Sub Total" Then
        Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = sum
        total = total + sum
        sum = 0
        End If
        If j = no_d Then 'When complete cycle will be positive sub total = total
         Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = total
        End If
    Next j

  j = 1
  For j = 1 To no_d
  If Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = "" Then
    Worksheets("MPS TEMPLATE").Cells(6 + j, 3).Value = 0
    End If
   Next j
  
End Function

[snasui]

ให้ยกเฉพาะ Code ที่ได้เขียนให้รวมไปด้านขวามาด้วย แจ้งด้วยว่า Code ใดไม่ทำงานหรือทำงานผิดพลาด หากเขียนมาเป็น Function Prucedure แทน Sub Procedure อีกผมจะไม่ตอบนะครับ ถือว่าแจ้งไปหลายรอบแล้ว รอบนี้ขอแจ้งเป็นรอบสุดท้าย

[วังวู ช่ง]

ค่อย ๆ ถามตอบกันไปครับ หลักการของ For...Next ศึกษาตามนี้ครับ For...Next

สำหรับ Code ที่ถามมา ผมขอแจ้งอีกรอบให้เปลี่ยนจาก Function เป็น Sub เพราะไม่ได้ทำงานอย่างเช่น Function ครับ

หากศึกษาแล้วไม่เข้าใจส่วนใดควรยกมาถามเฉพาะส่วนนั้นครับ

สนใจอย่างมากเลียครับ

[hutthaya]

ทำได้แล้วค่ะอาจาร์ย
ขอบคุณสำหรับคำแนะนำค่ะ