错误9：下标超出范围Excel VBA

Question

您好，我试图通过工作表中的某个值定义范围，但是我无法做到这一点。 我也不知道是什么导致了这个问题。

我的密码

   Dim row As Range
For Each row In [table2].Rows

For Each c In Worksheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value)
.Range((row.Columns(row.ListObject.ListColumns("RangeBegin").Index).Value) 
+ ":" + 
(row.Columns(row.ListObject.ListColumns("RangeEnd").Index).Value))

  If c.Value = "O" Then
     Sheets("master").Cells(2, 3).Copy
     Sheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Select
     c.Select
     ActiveSheet.Paste

Answer 1

For Each c In Worksheets(1).ListObjects(1).ListColumns("Sheet").DataBodyRange

    'some code here...

Next c

Worksheets(1)只是一个例子。 您可以将1替换为工作表的名称，例如Worksheets("Sheet1") 。

ListObjects(1)只是一个示例。 您可以将1替换为表的名称，例如ListObject("Table1") 。 如果工作表只有一个表，则可以将其保留为1。

---

这是如何在表格行中选择范围

Sub test()
    Dim r As ListRow
    Dim lo As ListObject
    Set lo = Worksheets(1).ListObjects(1)
    For Each r In lo.ListRows

        Debug.Print r.Range(1, lo.ListColumns("Sheet").Index).Value

    Next r
End Sub

Answer 2

我重构了您的代码。 我认为它非常接近您想要的。 请注意，我是如何从链接对象中提取变量的。 这样做是为了使代码更易读，更可靠并且最重要的是更易于调试。
如果“ Set targetRange”破坏了代码，我可以将鼠标悬停在SheetName，RangeBegin和RangeEnd上以找到它们各自的值。

SheetName = .ListColumns("Sheet").DataBodyRange(i)
RangeBegin = .ListColumns("RangeBegin").DataBodyRange(i)
RangeEnd = .ListColumns("RangeEnd").DataBodyRange(i)
Set targetRange = getTargetRange(SheetName, RangeBegin, RangeEnd)

 Public Sub ProcessWorkSheets() Dim tbl As ListObject Dim SheetName As String, RangeBegin As String, RangeEnd As String Dim targetRange As Range Set tbl = Sheet1.ListObjects("Table1") With tbl For i = 1 To tbl.DataBodyRange.Rows.Count SheetName = .ListColumns("Sheet").DataBodyRange(i) RangeBegin = .ListColumns("RangeBegin").DataBodyRange(i) RangeEnd = .ListColumns("RangeEnd").DataBodyRange(i) Set targetRange = getTargetRange(SheetName, RangeBegin, RangeEnd) If Not targetRange Is Nothing Then With Worksheets(SheetName) For Each c In targetRange If c = "O" Then c = Sheets("master").Cells(2, 3) Next End If End With Next End With End Sub Public Function getTargetRange(SheetName As String, RangeBegin As String, RangeEnd As String) As Range On Error Resume Next Set getTargetRange = Worksheets(SheetName).Range(RangeBegin & ":" & RangeEnd) On Error GoTo 0 End Function Public Function hasWorkSheet(SheetName As String) On Error Resume Next Call Worksheets(SheetName).Name If Err.Number <> 0 Then hasWorkSheet = False Else hasWorkSheet = True End If On Error GoTo 0 End Function 

您不必选择或激活范围。 最好直接使用Range对象而不是Select或Active对象。 知道我们可以删除任何活动或选择的行； 将多个操作与单个操作结合在一起。 更新的重构：

 Application.CopyObjectsWithCells = True 'I Don't this line is needed Dim row As Range For Each row In [table2].Rows For Each c In Worksheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Range(row.Value2(1, 2)) If c.Value = "O" Then Sheets("master").Cells(2, 3).Copy c ElseIf c.Value = "G" Then Sheets("master").Cells(3, 3).Copy c ElseIf c.Value = "R" Then Sheets("master").Cells(4, 3).Copy c End If Next c Next 

Answer 3

好的，最后，经过大量的尝试和尝试，我无需更改代码即可实现此目标。 如果条件满足，我将尝试读取每个单元格并粘贴其他单元格的内容

Application.CopyObjectsWithCells = True

Dim row As Range
For Each row In [table2].Rows

For Each c In Worksheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Range(row.Value2(1, 2))
  If c.Value = "O" Then
     Sheets("master").Cells(2, 3).Copy
     Sheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Select
     c.Select
     ActiveSheet.Paste

  ElseIf c.Value = "G" Then
     Sheets("master").Cells(3, 3).Copy
     Sheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Select
     c.Select
     ActiveSheet.Paste

  ElseIf c.Value = "R" Then
     Sheets("master").Cells(4, 3).Copy
       Sheets(row.Columns(row.ListObject.ListColumns("Sheet").Index).Value).Select
     c.Select
     ActiveSheet.Paste
  Else
      c.Value = c.Value
  End If
  Next c

 Next