snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
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
จากไฟล์ที่แนบมานี้ หนูต้องการคำนวณตามชื่อ product total ค่ะจะไม่คำนวณตามชื่อ sub total แล้วจะสามารถเปลี่ยนแปลงตรงไหนได้บ้างค่ะอาจารย์
summary.xlsx
You do not have the required permissions to view the files attached to this post.
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
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