'For Next'循环根据名称相似的工作表执行操作

我有一组具有相似名称的工作表，并希望对所有这些工作表执行一个操作（例如表名是1C ， 2C ， 3C等）。 我试过下面的代码，但我得到运行时错误424 ：

 Sub InsertURLType() Dim ws As Worksheet Dim LastCol As Integer For Each ws In Activebook.Sheets If ws.Name Like "?1" Then With ActiveSheet LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column End With LastRow = Range("A1").End(xlDown).Row Columns(LastCol).Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ActiveCell.Select ActiveCell.FormulaR1C1 = "URL Type" ActiveCell.Offset(1).Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],URLs!C1:C2,2,FALSE)" ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LastRow, ActiveCell.Column)) End If Next ws End Sub 

Answer 1

没有我知道的Activebook 。 像在ActiveWorkbook属性中一样尝试ActiveWorkbook 。

进一步来说，你应该处理ws工作表typesvariables，它是为For Each ... Next循环设置的。 A With … End With语句将允许所有进一步的操作将其作为工作表进行引用，以执行工作。

 Sub InsertURLType() Dim ws As Worksheet Dim LastRow As Long, LastCol As Long For Each ws In ActiveWorkbook.Sheets With ws If .Name Like "?1" Then '<~~ this doesn't appear to pattern match the WS names you described in your narrative LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column LastRow = .Range("A" & Rows.Count).End(xlUp).Row '<~~ look from the bottom up .Columns(LastCol).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove .Cells(1, LastCol) = "URL Type" .Cells(2, LastCol).Resize(LastRow - 1, 1).FormulaR1C1 = _ "=VLOOKUP(RC[-1], URLs!C1:C2, 2, FALSE)" End If End With Next ws End Sub 

你使用的掩码If .Name Like "?1" Then doe看起来不符合你在叙述中提供的工作表名称。 如果这不起作用，请提供所有工作表名称的列表以及要处理的工作表的子集。

这个简短的小组将检查您的工作表名称。

 Sub Check_WS_Names() Dim ws As Worksheet, strWSs As String strWSs = " 1C 2C 3C 4C 5C 6C 7C 8C 9C 10C 11C 12C 13C" & _ " 1O 2O 3O 4O 5O 6O 7O 8O 9O 10O 11O 12O 13O" & _ " 1S 2S 3S 4S 5S 6S 7S 8S 9S 10S 11S 12S 13S " For Each ws In ActiveWorkbook.Sheets With ws If CBool(InStr(1, strWSs, Chr(32) & .Name & Chr(32), vbTextCompare)) Then Debug.Print "found: " & .Name End If End With Next ws End Sub 

运行结果后，检查VBE的立即窗口（Ctrl + G）。