Question

我遇到For Each循环导致Excel挂起的问题。一切都在下面的代码中工作，直到我到达For Each C In ColRng代码。一旦删除，一切都会再次运作。

Sub CopyWB()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim i As Integer
Dim C As Range
Dim MemAnal, AttAnal As Variant
Dim ColRng As Range

Set MemAnal = Worksheets("Membership Analysis")
Set AttAnal = Worksheets("Attendance Analysis")

MemAnal.Select
    Set ColRng = Range(MemAnal.Cells(1, 1), MemAnal.Cells(1, MemAnal.UsedRange.Columns.Count))
    Range("E:J").EntireColumn.Insert
    Range("E1:J1").Value = Array("Site Status", "Org Service Unit", "Org Region", _
        "Location State", "Key State", "DOD")
    For Each C In ColRng
        If InStr(1, C.Text, "Total Member Count using Age Group for YTD") = 0 Then
            GoTo Break
        Else
            C.EntireColumn.Insert
            C.Offset(0, -1).Value = "Teens " & Left(C.Text, 4)
        End If
Break:
    Next C  

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

Answer 1

感谢@Rory指出了导致问题的原因。我已经改写以避免这种逻辑。以下是更新后的代码：

Sub CopyWB()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim i As Integer
Dim C, ColRng, pyAddress, cyAddress As Range
Dim MemAnal, AttAnal As Variant

Set MemAnal = Worksheets("Membership Analysis")
Set AttAnal = Worksheets("Attendance Analysis")

MemAnal.Select
    Range("E:J").EntireColumn.Insert
    Range("E1:J1").Value = Array("Site Status", "Org Service Unit", "Org Region", _ 
        "Location State", "Key State", "DOD")
    Set ColRng = Range(MemAnal.Cells(1, 1), MemAnal.Cells(1, _ 
        MemAnal.UsedRange.Columns.Count))
    Set pyAddress = ColRng.Find("Total Member Count using Age Group for YTD", LookIn:=xlValues)
    Set cyAddress = ColRng.FindNext(pyAddress)
    pyAddress.EntireColumn.Insert
    pyAddress.Offset(0, -1).Value = "Teens " & Right(pyAddress.Text, 4)
    cyAddress.EntireColumn.Insert
    cyAddress.Offset(0, -1).Value = "Teens " & Right(cyAddress.Text, 4)    

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

应该注意的是，这对我有用，因为我碰巧知道在这个数据中，我将只有这个文本的两个实例，但这些实例的位置不断变化，因此需要.Find功能。我只是在思考我最初是怎么做的。

每个循环导致Excel挂起

1 个答案: