- 帖子
- 354
- 主題
- 5
- 精華
- 0
- 積分
- 387
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-8-2
 
|
7#
發表於 2023-12-12 23:02
| 只看該作者
回復 6# av8d
Private Sub CommandButton1_Click()
'暫停四個容易拖慢的 Excel 功能
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
'Application.EnableEvents = False
'On Error Resume Next
'更新活頁簿：市民卡日報表
FN = "市民卡日報表" '檔案名稱
Set FNwb = Workbooks.Open(ThisWorkbook.Path & "\" & FN) '開啟該檔案
CB = Left(ComboBox1, Len(ComboBox1) - 3) '所設定的日期
'yTD = Format(CB, "yyyy") - 1911
mTD = Format(CB, "m")
dTD = Format(CB, "d")
FNTD = mTD & "月"
Dim FNcell As Range
For Each Z In FNwb.Sheets(FNTD).Range("C2:CM2")
If Z.Value = Int(Format((DateValue(CB)), 0)) Then
Set FNcell = Z
Exit For
End If
Next
ActiveWindow.ScrollColumn = FNcell.Column - 15
ActiveWindow.ScrollRow = FNcell.Row - 1
If Not FNcell Is Nothing Then
FNcell.Offset(1, 0).Select
For m = 7 To 12
For n = 1 To 4
ActiveCell.Offset(m, n - 1) = Cells(m + 5, n * 2)
Next
Next
For m = 19 To 24
For n = 1 To 4
ActiveCell.Offset(m, n - 1) = Cells(m, n * 2)
Next
Next
ActiveCell.Offset(-1, 0).Select
'更新[歷史合計]
Dim i As Integer, j As Integer
'當日合計貼到歷史合計B4:B9
For i = 4 To 9
Cells(i, 2) = Cells(i + 8, 4)
Next
'當日合計貼到歷史合計D4:D9
For i = 4 To 9
Cells(i, 4) = Cells(i + 8, 8)
Next
'當日合計貼到歷史合計F4:F9
For i = 4 To 9
Cells(i, 6) = Cells(i + 15, 4)
Next
'當日合計貼到歷史合計H4:H9
For i = 4 To 9
Cells(i, 8) = Cells(i + 15, 8)
Next
'清除[當日合計]
For i = 2 To 8 Step 2
For j = 12 To 17
Cells(j, i) = ""
Next
Next
For i = 2 To 8 Step 2
For j = 19 To 24
Cells(j, i) = ""
Next
Next
[K3:O15].ClearContents
[J20].ClearContents
Else
MsgBox "在【市民卡日報表】中找不到 " & CB & " ，動作終止。"
End If
'恢復四個容易拖慢的 Excel 功能
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
'Application.EnableEvents = True
End Sub |
|
