Snasui Excel Forum

Code: Select all

Public Function comparefmonth1mps1()
Application.ScreenUpdating = False
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 COMPARE").Cells(i + 6, 1).Value & Worksheets("MPS COMPARE").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 COMPARE
    
       pro2(i) = Worksheets("MPS COMPARE").Cells(6 + i, 1).Value
       cap2(i) = Worksheets("MPS COMPARE").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 COMPARE").Activate
   j = 1
  For j = 1 To no_d  'check month and procap

     If (Fmonth(i) = Worksheets("MPS COMPARE").Cells(6, 3).Value) And (pro = pro2(j)) And (cap = cap2(j)) Then
        Worksheets("MPS COMPARE").Cells(6 + j, 3).Value = commit(i)
        
        x = 1
        Exit For
   Else
     x = 0
     
     End If
    Next j
    Next i
    'คำนวณค่าตรง ชื่อroduct total
    sum = 0
    total = 0
      For j = 1 To no_d  'sum commit sub total
      If pro2(j) <> "Sub Total" Then
        sum = sum + Worksheets("MPS COMPARE").Cells(6 + j, 3).Value
       
      ElseIf pro2(j) = "Sub Total" Then
        Worksheets("MPS COMPARE").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 COMPARE").Cells(6 + j, 3).Value = total
        End If
    Next j

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

Code: Select all

      For j = 1 To no_d  'sum commit sub total
      r = pro2(j) + " Total" 'พอใช้ r มารับ
      If pro2(j) <> r Then
        sum = sum + Worksheets("MPS COMPARE").Cells(6 + j, 3).Value
       
      ElseIf pro2(j) = r Then
        Worksheets("MPS COMPARE").Cells(6 + j, 3).Value = sum
        total = total + sum
        sum = 0

Code: Select all

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