ระบายสี Grand Total ทุกครั้งเมื่อจบชื่อ family

[hutthaya]

MPS.xlsx

จะให้ชื่อ "Grand total 2.5" กับ"Grand total 3.5" ระบายสีเหมือน "Grand Total" ทำไงดีค่ะ
แนบไฟล์คู่กับโค้ดไม่ได้ค่ะไฟล์ใหญ่เกินไป รบกวนผู้รู้ช่วยตอบทีน่ะค่ะ ขอบคุณค่ะ

Code: Select all

Public Sub compareprocap() 'refferenccompare
              Application.ScreenUpdating = False
              ActiveWorkbook.Sheets("MPS COMPARE").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
                        Dim grand2 As Double
                        Dim grand3 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 '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 COMPARE")
                                        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
                                         target.Offset(-1, 0).Offset(0, 1).Font.Bold = True
                                          target.Offset(-1, 0).Offset(0, 1).Offset(0, 1) = r.Offset(0, 1).Offset(0, 1) 'form_fac
                                          Cells(6, 3) = "FORM_FACTOR"
                                        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 COMPARE").Range("a" & Range("a99999").End(xlUp).Row)
                                            .Offset(1, 0) = r + " Total"
                                            .Offset(1, 0).Font.Bold = True
                                            .Offset(1, 1).Font.Color = -10477568
                                            .Offset(1, 1).Font.Bold = True
                                            grandTotal = grandTotal
                                            subTotal = 0
                                        End With
                                        With Sheets("MPS COMPARE")
                                            Range("a" & target.Row - 1 & ":e" & target.Row - 1).Interior.Color = 13434777  'format paint
                                        End With
                                        Exit For
                                    Else
                                    End If
                                End If
                             Next r
                             grandTotal = grandTotal
                        Next item
                        With Sheets("MPS COMPARE").Range("a" & Rows.Count).End(xlUp)
                            .Offset(1, 0) = "Grand Total"
                             .Offset(1, 0).Font.Bold = True
                            .Offset(1, 1).Font.Color = 15773696
                            .Offset(1, 1).Font.Bold = True
        
                         
                            .Offset(1, 0).Offset(1, 0) = "Grand Total 2.5"
                             .Offset(1, 0).Offset(1, 0).Font.Bold = True
                             .Offset(1, 0).Offset(1, 0).Offset(1, 0) = "Grand Total 3.5"
                             .Offset(1, 0).Offset(1, 0).Offset(1, 0).Font.Bold = True

                           
                        End With
                        
                        With Sheets("MPS COMPARE")
                            Range("a" & target.Row & ":e" & target.Row).Interior.Color = 49407
                           
                        End With
                        
                          Columns("C:C").Select
    Selection.NumberFormat = "0.0;[Red]0.0"
                        
                        Application.ScreenUpdating = True
End Sub

[snasui]

แนบ Code มาในไฟล์แล้วชี้ให้เห็นว่า Code ที่เขียนมาเองแล้วนั้นติดขัดที่บรรทัดใด จะได้เข้าถึงข้อมูลโดยไวครับ

[hutthaya]

โปรแกรมอยู่ที่ Module1 ค่ะ คือหนูอยากให้
"Grand total 2.5" กับ"Grand total 3.5" ะบายสีออกมาเหมือน "Grand Total" ค่ะอาจารย์

MPS.xlsm

[niwat2811]

แบบนี้ใช้ได้ตรงตามต้องการไหมครับ

Code: Select all

Option Explicit
Public Function compareprocap() 'refferenccompare
              Application.ScreenUpdating = False
              ActiveWorkbook.Sheets("MPS COMPARE").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
                        Dim grand2 As Double
                        Dim grand3 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 '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 COMPARE")
                                        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
                                         target.Offset(-1, 0).Offset(0, 1).Font.Bold = True
                                          target.Offset(-1, 0).Offset(0, 1).Offset(0, 1) = r.Offset(0, 1).Offset(0, 1) 'form_fac
                                        
                                        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 COMPARE").Range("a" & Range("a99999").End(xlUp).Row)
                                            .Offset(1, 0) = r + " Total"
                                            .Offset(1, 0).Font.Bold = True
                                            .Offset(1, 1).Font.Color = -10477568
                                            .Offset(1, 1).Font.Bold = True
                                            grandTotal = grandTotal
                                            subTotal = 0
                                        End With
                                        With Sheets("MPS COMPARE")
                                            Range("a" & target.Row - 1 & ":e" & target.Row - 1).Interior.Color = 13434777  'format paint
                                        End With
                                        Exit For
                                    Else
                                    End If
                                End If
                             Next r
                             grandTotal = grandTotal
                        Next item
                        With Sheets("MPS COMPARE").Range("a" & Rows.Count).End(xlUp)
                            .Offset(1, 0) = "Grand Total"
                             .Offset(1, 0).Font.Bold = True
                            .Offset(1, 1).Font.Color = 15773696
                            .Offset(1, 1).Font.Bold = True
        
                         
                            .Offset(1, 0).Offset(1, 0) = "Grand Total 2.5"
                             .Offset(1, 0).Offset(1, 0).Font.Bold = True
                             .Offset(1, 0).Offset(1, 0).Offset(1, 0) = "Grand Total 3.5"
                             .Offset(1, 0).Offset(1, 0).Offset(1, 0).Font.Bold = True
                           
                        End With
                        
                        With Sheets("MPS COMPARE")
                            Range("a" & target.Row & ":e" & target.Row).Interior.Color = 49407
                            For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
                                If r = "Grand Total 2.5" Then
                                    r.Resize(1, 5).Interior.Color = 49407
                                End If
                                If r = "Grand Total 3.5" Then
                                    r.Resize(1, 5).Interior.Color = 49407
                                End If
                            Next r
                        End With
                        
                          Columns("C:C").Select
    Selection.NumberFormat = "0.0;[Red]0.0"
                        
                        Application.ScreenUpdating = True
End Function

[hutthaya]

ถูกค่ะ แต่ค่าที่ sum ทั้งหมดจะอยู่ที่ row "Grand Total" น่ะค่ะ
แล้วที่ "Grand Total 2.5" จะซัมชื่อ family ที่ตรงกับ 2.5 ในคอลัมน์ที่สาม ส่วน "Grand total 3.5" ็จะซัม row ตรงกับ 3.5 ค่ะ

[niwat2811]

ลองแบบนี้ใช้ได้ตามต้องการไหมครับ

Code: Select all

Sub test()
Dim r As Range
Dim lr As Long, lngRow As Long, lngStart As Long
Application.ScreenUpdating = False
With Sheets("NEWDATA")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    Range("A2:C" & lr).Copy Sheets("MPS COMPARE").Range("A2")
End With
Sheets("MPS COMPARE").Activate
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("C2:C" & lr).Copy Sheets("MPS COMPARE").Range("F1")
Range("F1:F" & lr).RemoveDuplicates Columns:=1, Header:=xlNo
Range("F1:F" & lr).Sort Columns(6), xlAscending
Range("F1:G1").Insert Shift:=xlDown
Range("G1").FormulaR1C1 = "=SUM(C[-5])"
Range("G2").FormulaR1C1 = "=SUMIFS(C[-5],C[-4],RC[-1])"
Range("G2").AutoFill Destination:=Range("G2:G" & Range("F" & Rows.Count).End(xlUp).Row)
With Range("G1", Range("G" & Rows.Count).End(xlUp))
    .Value = .Value
End With
For Each r In Range("G1", Range("G" & Rows.Count).End(xlUp))
    If r <> "" Then
        r.Offset(0, -1) = "Grand Total" & " " & r.Offset(0, -1)
    End If
Next r
lngStart = 2: lngRow = lngStart
Do: lngRow = lngRow + 1
    If Range("A" & lngRow) <> Range("A" & lngRow - 1) Then
        Rows(lngRow).Insert
        Range("B" & lngRow) = "=SUM(B" & lngStart & ":B" & lngRow - 1 & ")"
        Range("A" & lngRow).Value = Range("A" & lngRow - 1) & " " & "Total"
        Range("A" & lngRow).Resize(1, 5).Interior.Color = 13434777
        lngRow = lngRow + 1: lngStart = lngRow
    End If
Loop Until Range("B" & lngRow) = ""
For Each r In Range("F1", Range("F" & Rows.Count).End(xlUp))
    If r <> "" Then
        r.Resize(1, 2).Copy Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next r
For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If Left(r, 5) = "Grand" Then
        r.Resize(1, 5).Interior.Color = 49407
    End If
Next r
Columns("F:G").ClearContents
Columns("A:E").AutoFit
Range("A1").Activate
Application.ScreenUpdating = True
End Sub

[hutthaya]

มัน error ค่ะ
Range("F1:F" & lr).RemoveDuplicates Columns:=1, Header:=xlNo

[niwat2811]

ผมลอง Run ดูก็ได้ปกตินะครับ ก่อน Run เลือกชีท NEWDATA หรือเปล่าครับ
ลองลบข้อมูลที่ชีท MPS COMPARE แล้วเลือกชีท NEWDATA แล้ว Run Code ดูครับ

[hutthaya]

MPS.xlsm

จริงๆก้อถูกน่ะค่ะ แต่ผลลัพธ์ที่จะนำมาคำนวณจิงๆมันอยู่คอลัมน์ที่ 4,5ค่ะ
หนูแนบไฟล์ตัวอย่างผลลัพธ์จิงๆไปค่ะที่ Grand total จะคำนวณแค่ที่เปนฟอแมตเส้นฟ้าค่ะ
ส่วน Grand total2.5กับ 3.5ก็จะคำนวณทุกครั้งที่เจอ 2.5,3.5 ค่ะ

[niwat2811]

ข้อมูลที่ชีท NEWDATA ไม่เห็นมีข้อมูลของวันที่ 1 พ.ย. และ 1 ธ.ค.
แล้วที่ชีท MPS COMPARE ไม่ทราบว่าเอาข้อมูลของวันที่ 1 พ.ย. และ 1 ธ.ค. มาจากตรงไหนหรือครับ

[hutthaya]

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

[snasui]

คุณโพสต์คำถามคล้าย ๆ กันในหลาย ๆ กระทู้

กรณีเป็นเรื่องเดียวต่อเนื่องกันควรโพสต์ในกระทู้เดียวกัน จะได้ติดตามได้ว่าได้ทำไปถึงไหน

สำหรับ Code ที่ถามผมได้ตอบเป็นตัวอย่างไปแล้ว ดูได้ที่นี่ครับ viewtopic.php?f=3&t=6199#p39781