- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
回復 1# ji12345678 - Private Sub cbCal_Click()
- Dim iSCol%, iTCol%, iNum%
- Dim lSRow&, lTRow&
- Dim sStr$
- Dim shSou As Sheet1, shTar As Sheet3
- Set shSou = Sheets("總表")
- Set shTar = Sheets("變動")
-
- With shTar.Cells
- .ClearContents
- .Interior.ColorIndex = -4142
- End With
-
- With shSou
- iSCol = 2 ' 日期與增減量
- Do While .Cells(1, iSCol) <> ""
- shTar.Cells(1, iSCol) = .Cells(1, iSCol)
- shTar.Cells(2, iSCol) = "增減量"
- iSCol = iSCol + 1
- Loop
- sStr = Cells(1, iSCol - 1).Address
- sStr = Mid(sStr, 2, InStr(2, sStr, "$") - 2)
- shTar.Columns("B:" & sStr).ColumnWidth = 8.38
-
- lSRow = 3 ' 工班名
- Do While .Cells(lSRow, 1) <> ""
- shTar.Cells(lSRow, 1) = .Cells(lSRow, 1)
- lSRow = lSRow + 1
- Loop
-
- iSCol = 3
- Do While .Cells(1, iSCol) <> ""
- lSRow = 3
- Do While .Cells(lSRow, 1) <> ""
- sStr = .Cells(lSRow, 1)
-
- If Left(sStr, 1) <> "總" Then iNum = CInt(Mid(sStr, 2, Len(sStr) - 2)) Else iNum = 1
-
- With .Cells(lSRow, iSCol)
- shTar.Cells(lSRow, iSCol) = .Value - .Offset(, -1)
- End With
-
- With shTar.Cells(lSRow, iSCol)
- Select Case .Value
- Case Is > 0
- If iNum > 9 Then .Interior.ColorIndex = 41 Else .Interior.ColorIndex = 38
- Case 0
- .Interior.ColorIndex = -4142
- Case Is < 0
- If iNum > 9 Then .Interior.ColorIndex = 46 Else .Interior.ColorIndex = 35
- End Select ' 藍 41 橘 46 綠 35 粉 38
- End With
- lSRow = lSRow + 1
- Loop
- iSCol = iSCol + 1
- Loop
- End With
- End Sub
 問問題-102.10.2-a.zip (14.43 KB)
|
|
發表於 2013-10-4 00:04
| 