[英]Error 9 : subscript out of range Excel VBA
您好,我試圖通過工作表中的某個值定義范圍,但是我無法做到這一點。 我也不知道是什么導致了這個問題。
我的密碼
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
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
我重構了您的代碼。 我認為它非常接近您想要的。 請注意,我是如何從鏈接對象中提取變量的。 這樣做是為了使代碼更易讀,更可靠並且最重要的是更易於調試。
如果“ 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
好的,最后,經過大量的嘗試和嘗試,我無需更改代碼即可實現此目標。 如果條件滿足,我將嘗試讀取每個單元格並粘貼其他單元格的內容
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.