运行特定宏会冻结Microsoft Excel

我目前正在Microsoft Excel中使用以下宏。但是，每当我运行它时，应用程序就会冻结一段时间。不太确定我的代码中的问题可能在哪里：

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

    Cells.Select
    Selection.RowHeight = 20.25

Columns("E:E").Insert
Columns("E:E").ColumnWidth = 7
Columns("J:J").Insert
Columns("J:J").ColumnWidth = 7
Columns("L:L").Insert
Columns("L:L").ColumnWidth = 7
Columns("M:M").Insert
Columns("M:M").ColumnWidth = 7
Columns("M:M").Insert
Columns("M:M").ColumnWidth = 7
Columns("L:L").Copy
Range("J1").PasteSpecial xlPasteFormats
Application.CutCopyMode = flase

    For Each cel In Range("F:F")
        If cel.Font.Underline = xlUnderlineStyleSingle Then
            cel.Value = "x" & cel.Value
        End If
    Next
    For Each cel In Range("H:H")
        If cel.Font.Underline = xlUnderlineStyleSingle Then
            cel.Value = "x" & cel.Value
        End If
    Next




Application.ScreenUpdating = False

a = Cells(Rows.Count, "C").End(xlUp).Row





For b = 1 To a
If IsNumeric(Cells(b, "C").Value) Then
st = Cells(b, "G").Value


t1 = Cells(b, "F")
t2 = Cells(b, "H")

v1 = 1.72
v2 = 2.1
v3 = 1.9
v4 = 1.8
v5 = 2

If InStr(st, "+10") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v1
Cells(b, "J") = v2

ElseIf InStr(st, "-10") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v3
Cells(b, "J") = v3

ElseIf InStr(st, "-5") > 0 And Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v5
Cells(b, "J") = v4

ElseIf Left(Cells(b, "F"), 1) = "x" Then
Cells(b, "E") = v4
Cells(b, "J") = v5

ElseIf InStr(st, "+10") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v1
Cells(b, "E") = v2

ElseIf InStr(st, "-10") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v3
Cells(b, "E") = v3

ElseIf InStr(st, "-5") > 0 And Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v5
Cells(b, "E") = v4

ElseIf Left(Cells(b, "H"), 1) = "x" Then
Cells(b, "J") = v4
Cells(b, "E") = v5


ElseIf InStr(st, "-10") > 0 Then
Cells(b, "J") = v3
Cells(b, "E") = v3

Else
Cells(b, "E") = 0
Cells(b, "J") = 0

End If







End If
Next


Application.ScreenUpdating = True

End Sub

我相信问题可能与RAM或下面的代码片段有关，我已尝试修改它，但没有任何运气：

 For Each cel In Range("F:F")
            If cel.Font.Underline = xlUnderlineStyleSingle Then
                cel.Value = "x" & cel.Value
            End If
        Next
        For Each cel In Range("H:H")
            If cel.Font.Underline = xlUnderlineStyleSingle Then
                cel.Value = "x" & cel.Value
            End If
        Next

---

是的，在宏的开头，你已经用2个For循环解决了这个问题-你正在循环大约200万个单元格来检查它们的值。相反，您应该将搜索限制在只有值的区域。您已经在下面的这一行中做了进一步的工作：

a = Cells(Rows.Count, "C").End(xlUp).Row

因此，您应该类似地更改For循环-如果您愿意，您可以像对a所做的那样定义一个变量，并检查在F列和H列中有值的最低单元格是什么-但我将展示另一种方式：

For Each cel In Intersect(Sheets(1).Range("F:F"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

For Each cel In Intersect(Sheets(1).Range("H:H"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

---

请注意，根据工作表的索引号，您可能需要更改对上面工作表（1）的引用。

是的，您已经用宏开头的2个For循环解决了问题-您正在循环约200万个单元格以检查其值。相反，您应该将搜索限制在只有值的区域。您已经在下面的这一行中做了进一步的工作：

a = Cells(Rows.Count, "C").End(xlUp).Row

因此，您应该类似地更改For循环-如果您愿意，您可以像对a所做的那样定义一个变量，并检查在F列和H列中有值的最低单元格是什么-但我将展示另一种方式：

For Each cel In Intersect(Sheets(1).Range("F:F"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

For Each cel In Intersect(Sheets(1).Range("H:H"), Sheets(1).UsedRange)
    If cel.Font.Underline = xlUnderlineStyleSingle Then
        cel.Value = "x" & cel.Value
    End If
Next

---

请注意，您可能需要根据您的工作表所在的索引号更改对上述工作表（1）的引用。

使用范围

F:F

意味着它适用于整个

F

列。是否填充了整列

F

中的每一行？如果不是，则缩小范围以仅包括包含数据的行。同样的事情也适用于

H:H

。是的，不要对范围（“H:H”）中的每个cel执行

，因为这会检查整个列。找到最后一行（类似于
Dim lastRow as Integer//lastRow=cells（rows.count，1）。End（xlUp）。row
，并执行
范围（“H1:H”&lastRow）
或类似操作。（只需更改
cells（）中的
1
以使列与要检查的数据相匹配）好的，我会尝试感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢感谢el在范围内（“H:H”）
，因为这会检查整个列。查找最后一行（类似于
Dim lastRow as Integer//lastRow=cells（rows.count，1）。结束（xlUp）。行
，并执行
range（“H1:H”&lastRow）
等操作。（只需更改
cells（）
中的
1
以使列与要检查的数据相匹配）好的，我会尽量感谢Hanks的工作注意，UsedRange从技术上讲并不是完美的解决方案，因为格式化一个没有值的单元格被认为是工作表UsedRange的一部分。但是，对于类似这样的事情，我发现实现要快一点，并且可以快速地用于混合和匹配搜索范围，如中所示在这种情况下，您可能需要找到两列的单独限制。请注意，从技术上讲，UsedRange并不是完美的解决方案，因为格式化一个没有值的单元格被认为是工作表UsedRange的一部分。但是，对于类似的情况，我发现实现要快一点，并且可以用于在本例中，您可能需要找到两列的单独限制，因此需要混合和匹配搜索范围。