[發問] 請教如何用VBA在另一工作表計算出結果？

請教：
總表內為統計各班的生產量，
增減量工作表，為每個月的生產量增減值。
目前是以EXCEL函數處理。
因資料量龐大，請教一下大大，如何運用VBA，在另一個工作表產生增減量表，並產生每個格內的顏色格式設定。

工1班到工9班：增減量如果較上個月"增加"顏色為紅色，
增減量如果較上個月"減少"顏色為綠色。
工10班到工15班：增減量如果較上個月"增加"顏色為藍色，
增減量如果較上個月"減少"顏色為橘色。

問問題-102.10.2.rar (3.62 KB)

樓主熱帖

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

2^#

發表於 2013-10-3 23:29 | 只看該作者

本帖最後由 kimbal 於 2013-10-3 23:34 編輯

回復 1# ji12345678

Sub TEST()
Dim color As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("總表").Copy after:=Sheets(1)
With ActiveSheet.Range("B3")
Range(.Address, .End(xlToRight).End(xlDown)).ClearFormats
Range(.Address, .End(xlToRight).Offset(0, -1).End(xlDown)).Select
Selection.Copy
.Offset(0, 1).PasteSpecial operation:=xlPasteSpecialOperationSubtract
For Each Rng In Range(.Offset(0, 1), .End(xlToRight).End(xlDown))
color = 0
If Rng.Row >= 12 And Rng.Row <= 17 Then
If Rng.Value > 0 Then
color = 15773696
ElseIf Rng.Value < 0 Then
color = 52479
End If
Else
If Rng.Value > 0 Then
color = 255
ElseIf Rng.Value < 0 Then
color = 5296274
End If
End If
If color > 0 Then
With Rng.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = color
End With
End If
Next
Range(.Address, .End(xlDown)).Clear
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

複製代碼

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2025-7-5

3^#

發表於 2013-10-4 00:04 | 只看該作者

回復 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