作者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/cn.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