作者DADsays (YOLO)
看板Office
標題[問題] EXCEL VBA代碼執行問題
時間Mon Oct 23 20:42:24 2023
1. 軟體版本：Excel 2016
2. 因並無VBA編程背景，以下代碼串為使用ChapGPT逐步修改所得之最終版本。
3. 此代碼運行主要目的：將所選取之指定行，向下複製額外15行，並且指定將年/月（YY
YY/MM)欄位，隨行數增加，一併遞增年份及月份，指定由2023/10遞增至2024/12（共15行
），其他填充格內容則保持不變。
https://i.imgur.com/rmxvx2M.jpg
4. 目前此最終版本能夠執行出上述結果，但是當重覆對不同行執行此VBA代碼，執行速度
會越變越慢…到最後直接轉白圈當掉了….（總共有約370行需執行此指令）…檔案報銷了
好幾次…估計是在運行時暫存或儲存了很多沒必要的選取資料或迴路..
5. 最終版代碼如下，請大神幫忙檢視問題有可能出在哪，及該如何修改此代碼以解決此
問題！感謝！（請盡量以白話解釋，小弟無代碼背景）
Sub CopyAndFillYearMonth()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim i As Long
Dim xRng As Range
Dim NumMonths As Integer
Dim StartDate As Date
On Error Resume Next
Set xRng = Application.InputBox("Please select the range of rows to copy:"
, "Kutools for Excel", , , , , , 8)
If xRng Is Nothing Then Exit Sub
NumMonths = 15
StartDate = DateValue("2023/10/1")
xRng.Select
For i = 1 To NumMonths
xRng.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(, 4).NumberFormat = "yyyy/mm"
ActiveCell.Offset(, 4).Value = Format(StartDate, "yyyy/mm")
StartDate = DateAdd("m", 1, StartDate)
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculate
End Sub
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 184.22.100.190 (泰國)
※ 文章網址: https://webptt.com/m.aspx?n=bbs/Office/M.1698064946.A.E04.html
1F：推 ramblelife: 把程式貼上chatgpt,請他修改，並備註 10/23 23:41
2F：推 newacc: 一次執行一行嗎？還是會一次選取370行？ 10/24 10:48
3F：→ DADsays: 一次執行一行 10/24 14:50
4F：推 a29976137: 直接告訴gpt 要選取儲存格 10/24 21:25