Question

这绝对是以前被问到的，但我只是想知道我的代码有什么问题，因为它以前工作过，现在它突然抛出运行时错误91

          Private Sub Worksheet_Activate()
          Dim r As Range, rng As Range, snRow As Range, TmRow As Range
          Dim x As Integer, ETRow As Long, LTRow As Long
          Dim TMName As String
          Application.ScreenUpdating = False
          ETRow = 10: LTRow = 10
          ActiveSheet.Range("C4:AG5,C10:L38").ClearContents
          For x = 1 To Sheets.Count
          If Sheets(x).Name <> "Summary" Then
          With Sheets(Sheets(x).Name)
          TMName = Left(Sheets(x).Name, 6)
          With .Range("C:C")
          Set snRow = .Find("Total Staff", LookIn:=xlValues,LookAt:=xlWhole)
          End With
          Set rng = .Range("D5", "AH5")
          For Each r In rng
            If InStr(1, r.Value, "LT") > 0 Then
                With Sheets("Summary")
                  .Cells(4, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                    With .Range("C9:F9")
                        Set TmRow = .Find(TMName, LookIn:=xlValues, LookAt:=xlWhole)
                    End With
    *************ERROR HERE---> .Cells(ETRow, TmRow.Column) = Left(r.Value, InStr(1, r.Value, "ET", vbTextCompare) - 1)
                    ETRow = ETRow + 1
                End With
                    ElseIf InStr(1, r.Value, "LT") > 0 Then
                     With Sheets("Summary")
                    .Cells(5, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                    With .Range("I9:L9")
                        Set TmRow = .Find(TMName, LookIn:=xlValues, LookAt:=xlWhole)
                    End With
                     .Cells(LTRow, TmRow.Column) = Left(r.Value, InStr(1, r.Value, "LT", vbTextCompare) - 1)
                    LTRow = LTRow + 1
                End With

            End If
        Next
    End With
End If
   Next
   Application.ScreenUpdating = True
   End Sub

提前谢谢

Answer 1

正如Andy G提到你的嵌套With语句可能是你的问题的原因，我认为下面的代码将帮助你找到问题，如果有的话，还根据Scott Craner的评论修改了代码：

Private Sub Worksheet_Activate()
Dim r As Range, rng As Range, snRow As Range, TmRow As Range
Dim x As Integer, ETRow As Long, LTRow As Long
Dim TMName As String
Application.ScreenUpdating = False
ETRow = 10: LTRow = 10
ActiveSheet.Range("C4:AG5,C10:L38").ClearContents
For x = 1 To Sheets.Count
    If Sheets(x).Name <> "Summary" Then
        TMName = Left(Sheets(x).Name, 6)
        Set snRow = Sheets(Sheets(x).Name).Range("C:C").Find("Total Staff", LookIn:=xlValues, LookAt:=xlWhole)
        Set rng = Sheets(Sheets(x).Name).Range("D5", "AH5")
        For Each r In rng
            If InStr(1, r.Value, "ET") > 0 Then
                Sheets("Summary").Cells(4, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                Set TmRow = Sheets("Summary").Range("C9:F9").Find(TMName, LookIn:=xlValues, LookAt:=xlWhole)
                Sheets("Summary").Cells(ETRow, TmRow.Column) = Left(r.Value, InStr(1, r.Value, "ET", vbTextCompare) - 1)
                ETRow = ETRow + 1
            ElseIf InStr(1, r.Value, "LT") > 0 Then
                Sheets("Summary").Cells(5, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                Set TmRow = Sheets("Summary").Range("I9:L9").Find(TMName, LookIn:=xlValues, LookAt:=xlWhole)
                Sheets("Summary").Cells(LTRow, TmRow.Column) = Left(r.Value, InStr(1, r.Value, "LT", vbTextCompare) - 1)
                LTRow = LTRow + 1
            End If
        Next
    End If
Next x
Application.ScreenUpdating = True
End Sub

VBA运行时错误91 - 代码问题？

1 个答案: