Excel VBA:下标超出范围错误：For循环：多个工作表-表创建

VBA新手：代码在第一个工作表上运行良好，但在其余工作表上抛出错误

Dim st As Worksheet     
Set st = ActiveSheet 
  
  For Each ws In ThisWorkbook.Worksheets
     ws.Activate

  ''--------------------------------''
 'Print lables on worksheet'
 ''------------------------------''
 ws.Cells(2, 15).value = "Greatest_increase"
 ws.Cells(3, 15).value = "Greatest_decrease"
 ws.Cells(4, 15).value = "Greatest total"
 ws.Cells(1, 16).value = "name"
 ws.Cells(1, 17).value = "Value"


  'Print values on worksheet'
 ''------------------------------------------------------''
  ws.Range("P2").value = name1
  ws.Range("P3").value = name2
  ws.Range("P4").value = name3
  ws.Range("Q2").value = GreatIncrease
  ws.Range("Q3").value = GreatDecrease
  ws.Range("Q4").value = GreatTotal
 
 `'Create a table "Growth_Table" for range("O1:Q4")'
  '-----------------------------------------------------------------------''
  Dim tablename As String
  Dim TableExists As Boolean
  
  'tablename = "Growth_Table"      
   TableExists = False
  
On Error GoTo Skip
If ActiveSheet.ListObjects("Growth_Table").Name = "Growth_Table" Then
TableExists = True
End If
Skip:
    On Error GoTo 0
     
If Not TableExists And (ws.Range("O2").value = "Greatest_increase") Then
     
    ActiveSheet.ListObjects.Add(xlSrcRange, ws.Range("O1:Q4"), , xlYes).Name = "Growth_Table"
    ActiveSheet.ListObjects("Growth_Table").TableStyle = "TableStyleLight9"
     
Else
    Exit Sub
     
         End If
 

      Next 
st.Activate

工作表名为A、B、C、D。我想通过循环运行所有工作表的代码。但代码在sheetA上运行良好，但在sheetB上抛出的下标超出范围。 是否因为“增长表”已经存在于工作表A中？有办法吗

请帮忙

将表格添加到每个工作表中

• 测试时未将值写入工作表

代码

Option Explicit

Sub addTables()
    
    Const tblName As String = "Growth_Table"
    Const tblAddress As String = "O1:Q4"
    Const tblStyle As String = "TableStyleLight9"
    
    Dim ash As Worksheet: Set ash = ActiveSheet
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    
    For Each ws In ThisWorkbook.Worksheets
     
        'Write lables to worksheet
        ws.Range("O2").Value = "Greatest_increase"
        ws.Range("O3").Value = "Greatest_decrease"
        ws.Range("O4").Value = "Greatest total"
        ws.Range("P1").Value = "Name"
        ws.Range("Q1").Value = "Value"
        
        'Write values to worksheet
        ws.Range("P2").Value = name1
        ws.Range("P3").Value = name2
        ws.Range("P4").Value = name3
        ws.Range("Q2").Value = GreatIncrease
        ws.Range("Q3").Value = GreatDecrease
        ws.Range("Q4").Value = GreatTotal
         
        'Try to create a reference to (set) the table
        Set tbl = Nothing
        On Error Resume Next
        Set tbl = ws.ListObjects(tblName)
        On Error GoTo 0
     
        'Create table.
        If tbl Is Nothing Then 'Table does not exist
            Set tbl = ws.ListObjects.Add(xlSrcRange, _
                ws.Range(tblAddress), , xlYes)
            tbl.Name = tblName
            tbl.TableStyle = tblStyle
        'Else 'Table already exists
        End If
    
    Next ws
    
    ash.Activate

End Sub

---

首先重写它，使其不依赖于

ActiveSheet

和

ws.Activate

——这就是这些问题的根源。因为您已经有了工作表对象，所以您可以将所有

ActiveSheet.ListObjects

更改为

ws.ListObjects

IndexOutfrange

异常仅在超出数组或集合的边界时发生。使用调试器一步一步地检查代码，通过假设存在某个不存在的东西，找出要通过该数组或集合结尾的位置。谢谢大家！尝试使用ws。还是不起作用……那太好了！非常感谢你！