各位前輩你們好!!
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
[Q2].Copy
ActiveCell.Select
ActiveSheet.Paste
ElseIf e = 2 Then
ActiveCell.Offset(, 1).Select
[R2].Copy
ActiveCell.Select
ActiveSheet.Paste
ElseIf e = 3 Then
ActiveCell.Offset(, 1).Select
[S2].Copy
ActiveCell.Select
ActiveSheet.Paste
End If
End With
Next
End With
End With
[G:S].EntireColumn.AutoFit
清單
ElseIf vbNo Then
End
End If
[G1].Select
End Sub
問題如附檔說明
請知道的前輩,不吝賜教謝謝再三!!作者: myleoyes 時間: 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
謝謝各位前輩!!
