时间戳

首页 > 解决方案 > VBA：下标超出范围错误：For循环：多个工作表-表创建

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。我想通过循环运行所有工作表的代码。但是代码在工作表A上运行良好，但在工作表B上抛出'下标超出范围。是因为“增长表”已经存在于工作表 A 上吗？有什么修复吗？

请帮忙！

标签： excelvba

解决方案

将表格添加到每个工作表

  • 在没有将值写入工作表的情况下进行了测试。

编码

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

推荐阅读