- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# wiemanson - Option Explicit
- Sub Ex()
- Dim x As Integer, S As Variant, AR(), AC()
- With ActiveSheet
- AC = Array("紅", "綠", "藍", "黃") '顏色陣列: 指定顏色(0-3),顏色可再增加(0-?)
- AR = Array("E3", "F3", "G3", "H3", "I3") '顏色位置陣列 (紅,綠,藍,黃,總重量): 儲存格的位置(0-4)
- '總重量位置 :UBound(AR) -> 顏色位置陣列的索引值
- .Range(AR(0) & ":" & AR(UBound(AR))) = ""
- x = 2
- Do While .Cells(x, 1) <> ""
- If .Cells(x, 4) = "新" Then
- S = UBound(AR) '
- .Range(AR(S)) = .Range(AR(S)) + Cells(x, 2)
- Else
- S = Mid(.Cells(x, 1), 1, 1) '如紅紅時可讀取"紅"
- If .Cells(x, 3) = "大" Then S = "綠"
- S = Application.Match(S, AC, 0) 'Match 如找不到:傳回錯誤值
- If IsNumeric(S) Then 'S: 在指定顏色陣列中的位置
- .Range(AR(S - 1)) = .Range(AR(S - 1)) + .Cells(x, 2)
- End If
- End If
- x = x + 1
- Loop
- S = UBound(AR)
- .Range(AR(S)) = .Range(AR(S)) + Application.Sum(.Range(AR(0) & ":" & AR(S - 1)))
- End With
- End Sub
- Sub aa()
- Dim x As Integer, sum1 As Long, sum2 As Long, sum3 As Long, sum4 As Long, sum5 As Long, sum6 As Long
- x = 2
- sum1 = 0
- sum2 = 0
- sum3 = 0
- sum4 = 0
- sum5 = 0
- Do While Cells(x, 1) <> ""
- If Cells(x, 4) = "新" Then
- sum5 = sum5 + Cells(x, 2).Value
- ElseIf Cells(x, 1) = "紅" Then
- sum1 = sum1 + Cells(x, 2).Value
- ElseIf Cells(x, 1) = "紅紅" Then
- sum1 = sum1 + Cells(x, 2).Value
- ElseIf Cells(x, 1) = "綠" Or Cells(x, 3) = "大" Then
- sum2 = sum2 + Cells(x, 2).Value
- ElseIf Cells(x, 1) = "藍" Then 'Cells(x, 3) !!!
- sum3 = sum3 + Cells(x, 2).Value
- ElseIf Cells(x, 1) = "黃" Then 'Cells(x, 3) !!!
- sum4 = sum4 + Cells(x, 2).Value
- End If
- x = x + 1
- Loop
- Cells(3, 5) = sum1
- Cells(3, 6) = sum2
- Cells(3, 7) = sum3
- Cells(3, 8) = sum4
- Cells(3, 9) = sum5 + sum1 + sum2 + sum3 + sum4
- End Sub
|
|
發表於 2014-4-15 07:59
| 