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

看板Office作者DADsays (YOLO)時間1年前 (2023/10/23 20:42)推噓3(3推 0噓 1→)

留言4則, 4人參與討論串1/1

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://www.ptt.cc/bbs/Office/M.1698064946.A.E04.html