[問題] EXCEL VBA代碼執行問題

作者: DADsays (爸爸說)   2023-10-23 20:42:24
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
作者: ramblelife (人之患)   2023-10-23 23:41:00
把程式貼上chatgpt,請他修改,並備註
作者: newacc (XD)   2023-10-24 10:48:00
一次執行一行嗎?還是會一次選取370行?
作者: DADsays (爸爸說)   2023-10-24 14:50:00
一次執行一行
作者: a29976137 (billy)   2023-10-24 21:25:00
直接告訴gpt 要選取儲存格

Links booklink

Contact Us: admin [ a t ] ucptt.com