- 帖子
- 463
- 主題
- 116
- 精華
- 0
- 積分
- 580
- 點名
- 0
- 作業系統
- Vista
- 軟體版本
- 2007
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-4
- 最後登錄
- 2017-11-13
 
|
2#
發表於 2013-4-2 21:56
| 只看該作者
回復 1# myleoyes
各位前輩你們好!!
小弟突然想到這修改就可以省略Q2:S2補助儲存格如下
Sub 執行()
Dim Rng As Range
If MsgBox("您確定要執行嗎?", vbYesNo) = vbYes Then
[G1] = "": ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToRight:=4
With ActiveSheet
ActiveCell = ""
Set Rng = ActiveCell.Offset(, 7)
Rng = Date
Again:
A = Application.InputBox("輸入數據", " 請輸入數據", Type:=1)
If A = 0 Or A < 0 Then
Cancel = True: GoTo Again
Else
Selection.Offset(, 8) = A
End If
Again1:
aa = Application.InputBox("輸入數字", " 請輸入數字", Type:=1)
If aa = 0 Or aa < 0 Then
Cancel = True: GoTo Again1
Else
Selection.Offset(, 9) = aa
End If
With Rng.Cells(1, 4)
For Each e In Array(1, 2, 3)
With .Cells(1, e)
.FormulaR1C1 = Cells(1, .Column).FormulaR1C1
If e = 1 Then
ActiveCell.Offset(, 10).Select
If [N4] = "" Then
[Q4] = "=IF(N4="""","""",I4*O4*P4)"
[Q4].Copy
ActiveCell.Select
ActiveSheet.Paste
[Q4] = ""
ElseIf [N4] <> "" Then
[Q4] = "=IF(N4="""","""",I4*O4*P4)"
[Q4].Copy
ActiveCell.Select
ActiveSheet.Paste
End If
ElseIf e = 2 Then
ActiveCell.Offset(, 1).Select
If [N4] = "" Then
[R4] = "=IF(N4="""","""",Q4-L4)"
[R4].Copy
ActiveCell.Select
ActiveSheet.Paste
[R4] = ""
ElseIf [N4] <> "" Then
[R4] = "=IF(N4="""","""",Q4-L4)"
[R4].Copy
ActiveCell.Select
ActiveSheet.Paste
End If
ElseIf e = 3 Then
ActiveCell.Offset(, 1).Select
If [N4] = "" Then
[S4] = "=IF(N4="""","""",R4/(Q4-R4))"
[S4].Copy
ActiveCell.Select
ActiveSheet.Paste
[S4] = ""
ElseIf [N4] <> "" Then
[S4] = "=IF(N4="""","""",R4/(Q4-R4))"
[S4].Copy
ActiveCell.Select
ActiveSheet.Paste
End If
End If
End With
Next
End With
End With
[G:S].EntireColumn.AutoFit
清單
ElseIf vbNo Then
End
End If
[G1].Select
End Sub
謝謝各位前輩!! |
|
