求解！Excel的VBA一开始运行时间大概在5秒左右吧，但是今天突然变成5分钟了！求大神救命！！

Posted 2023-04-23

首先表明我所写代码的意思：
(本人自学的，好多都不懂，如果能加上注释是在感激不尽)
1.首先我做了一个对象，作为这个vba事件的启动按钮；
2.将表格“出库单”里的值给到表格“出库明细单”里，例如将sheets"出库单"的B2的值给到sheets"出库明细表"A1，将sheets"出库单"的C3的值给到sheets"出库明细表"A2；
3.将表格“出库单”里的值给到表格“出库数据记录表”里，这不同于上面的流程，因为他需要循环sheets"出库表"里的每一行数据，去记录每个产品出去的数量。
4.新建表格自动命名，将sheets"出库单"整张表格的有数据的范围复制到新表格。
以下就是本人写的VBA：
Sub 一键出库()

Dim n%, x%, y%, hs%
Set ab = Sheets("出库单")
Set bb = Sheets("出库明细表")
Set cb = Sheets("出库记录数据库")

a = Format(ab.Range("D5"), "(出库yyyy-mm-dd-")
b = ab.Range("B5").Value
c = ab.Range("B4").Value & ")"

x = bb.Range("B" & Rows.Count).End(3).Row + 1
bb.Range("B" & x).Value = ab.Range("D5").Value
bb.Range("C" & x).Value = ab.Range("D4").Value
bb.Range("D" & x).Value = ab.Range("B4").Value
bb.Range("E" & x).Value = ab.Range("B5").Value
bb.Range("F" & x).Value = a & b & c
bb.Range("G" & x).Value = ab.Range("A8").Value
bb.Range("H" & x).Value = ab.Range("B8").Value
bb.Range("I" & x).Value = ab.Range("C8").Value
bb.Range("J" & x).Value = ab.Range("D8").Value
bb.Range("K" & x).Value = ab.Range("E8").Value
bb.Range("L" & x).Value = ab.Range("F8").Value
bb.Range("M" & x).Value = ab.Range("G8").Value
bb.Range("N" & x).Value = ab.Range("E5").Value
bb.Range("O" & x).Value = ab.Range("F5").Value
bb.Range("P" & x).Value = ab.Range("G5").Value
bb.Range("Q" & x).Value = ab.Range("H5").Value
bb.Range("R" & x).Value = ab.Range("H8").Value
bb.Range("A" & x & ":R" & x).Borders.LineStyle = xlContinuous

n = ab.Range("B" & Rows.Count).End(3).Row
For hs = 11 To n
y = cb.Range("B" & Rows.Count).End(3).Row + 1
cb.Range("B" & y).Value = ab.Range("D5").Value
cb.Range("C" & y).Value = ab.Range("D4").Value
cb.Range("D" & y).Value = ab.Range("B4").Value
cb.Range("E" & y).Value = ab.Range("B5").Value
cb.Range("F" & y).Value = ab.Range("B" & hs).Value
cb.Range("G" & y).Value = ab.Range("C" & hs).Value
cb.Range("H" & y).Value = ab.Range("D" & hs).Value
cb.Range("I" & y).Value = ab.Range("H8").Value
cb.Range("A" & y & ":I" & y).Borders.LineStyle = xlContinuous
Next

Worksheets.Add.Name = a & b & c

ab.Select
Range("B4").Select

ab.Range("A1:H" & n).Copy Sheets(a & b & c).Range("A1")

Sheets(a & b & c).Columns("A:H").ColumnWidth = 30
Sheets(a & b & c).Rows("1:2000").RowHeight = 30
Sheets(a & b & c).Visible = xlSheetHidden

MsgBox "出库完成！"

End Sub

参考技术A 用
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
套住这个主程序看看。 参考技术B 一开始运行时间大概是五秒钟左右，但是今天突然变成了五分钟，我觉得这应该是调错了。追问

我没动程序代码，就是很突然，但我这个程序会增加某一表格的空间的，日积月累，有个表格后面可能会持续增加到很多行的数据

参考技术C 可能是今天周末，电脑也想偷个懒。

Excel VBA循环

【中文标题】Excel VBA循环

【英文标题】：Excel VBA Looping

【发布时间】：2017-05-26 18:25:28

【问题描述】：

好吧，请耐心等待，我对 Excel 中的 VBA 很陌生。几天来，我一直试图弄清楚如何循环输入我为错误检查而制作的时间表，我只是傻眼了。

我的时间表看起来像这样

所以我一直试图让一个循环来寻找空单元格。

我的范围是 ("C4:I4") 并且我需要在从 C4 开始的 29 行上运行它。

如果某一行在该范围内的每个单元格中都有数据，那么我希望将它发送到GoTo 500。 如果一行有任何单元格中的数据但未全部填写，我需要它显示一个MsgBox 来告诉用户需要填写什么。 如果除第一个之外的一行中的整个范围为空，那么我需要GoTo 500 来运行代码的保存文件部分。

任何帮助将不胜感激。我浏览了论坛并试图让多个循环示例为我工作，但一直无法做到。

Sub checkemptycells()

    Dim x As String

    Range("C1").Select
    If ActiveCell.Text = "" Then
        MsgBox "Pick Your Name"
        GoTo 1000
    End If

    Range("G1").Select
    If ActiveCell.Text = "" Then
        MsgBox "ENTER A DATE"
        GoTo 1000
    End If

    Range("C4").Select
    If ActiveCell.Text = "" Then
        MsgBox "Need Job#"
        GoTo 1000
    End If

    Range("D4").Select
    If ActiveCell.Text = "" Then
        MsgBox "need qty."
        GoTo 1000
    End If

    Range("E4").Select
    If ActiveCell.Text = "" Then
        MsgBox "Need Work Order!"
        GoTo 1000
    End If

    Range("F4").Select
    If ActiveCell.Text = "" Then
        MsgBox "Pick a Dept.!"
        GoTo 1000
    End If

    Range("G4:I4").Select
    If ActiveCell.Text = "" Then
        MsgBox "Fill Start & Stop times on this line"
        GoTo 1000
    End If

    Dim FilePath As String
    Dim FileName As String
    Dim MyDate As String
    Dim USER As String

    FilePath = "Z:\TIMESHEETS\"
    MyDate = Format(Now(), "mm_dd_yyyy_")
    USER = (ActiveSheet.Range("  C1"))

    FileName = FilePath & MyDate & USER
    ActiveWorkbook.SaveAs FileName:=FileName, FileFormat:=xlWorkbookNormal
    ActiveWorkbook.Close
    OpenAfterPublish = False
    xls.DisplayAlerts = False

1000
End Sub

【参考方案1】：

这样的东西有用吗？

Dim i as Variant
Dim j as Variant

For i = 4 to 32
For j = 3 to 9

    If Cells(i,j).Value="" Then

    MsgBox "Missing value in Cell(" & i & " ," & j & ")."

    End If

Next j
Next i

【讨论】：

先声明范围然后使用单个 For Each 循环而不是嵌套循环可能更有意义。

@J_Lard 我尝试将 Dim Rng 设置为 Range，Rng = Range("C4:I32")，然后仍然发现自己在嵌套循环。相比之下，这似乎更容易。如果我做错了，那为什么思考起来很痛苦也是有道理的……

你可以说Set rng = Range("C4:I32")，然后是For Each c in rng... If c.Value = ""...。无论哪种方式都应该有效:)

明白了！感谢您下次提供的提示...我自己对循环还是很陌生。迄今为止，我得到了很多帮助才能到达我所在的位置。