- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2025-7-5
|
12#
發表於 2013-11-5 23:38
| 只看該作者
回復 11# donod
電腦這幾天又掛了,到今天程式才弄出來.
你看看是否OK, 程式如下:- Sub nn()
- Dim iCol%, iCols%, iNum%, iIdx%, iI%, iJ%
- Dim lRow&, lRows&, lSum&(0 To 1)
- Dim bChk(0 To 1, 0 To 1) As Boolean
-
- lSum(0) = 0
- lSum(1) = 0
- For lRow = 9 To 11
- For iI = 0 To 1
- For iJ = 0 To 1
- bChk(iI, iJ) = False
- Next
- Next
- For iCol = 2 To 18
- With Cells(lRow, iCol)
- If Not .Value = "" Then ' 無數字不處理
- iIdx = IIf(.Interior.ColorIndex = 43, 1, 0)
- If Left(.Value, 1) = "[" Then
- bChk(iIdx, 0) = True
- iNum = Val(Mid(.Value, 2, Len(.Value) - 2))
- Else
- bChk(iIdx, 0) = False
- iNum = Val(.Value)
- End If
-
- If Not bChk(iIdx, 0) And bChk(iIdx, 1) Then
- bChk(iIdx, 1) = False
- ElseIf iNum >= Cells(5, 2 + iIdx * 2) Then
- lSum(iIdx) = lSum(iIdx) + Cells(5, 2 + iIdx * 2)
- If bChk(iIdx, 0) Then bChk(iIdx, 1) = True
- ElseIf iNum <= Cells(5, 3 + iIdx * 2) Then
- lSum(iIdx) = lSum(iIdx) + Cells(5, 3 + iIdx * 2)
- If bChk(iIdx, 0) Then bChk(iIdx, 1) = True
- Else
- If Not bChk(iIdx, 0) Then
- lSum(iIdx) = lSum(iIdx) + iNum
- bChk(iIdx, 1) = False
- End If
- End If
- End If
- End With
- Next iCol
- Next lRow
- MsgBox "綠色格總數為 : " & lSum(1) & Chr(10) & Chr(10) & Chr(10) & "無色格總數為 : " & lSum(0)
- End Sub
|
|
