首页 > 解决方案 > 下标超出范围

问题描述

我的代码有问题。我正在尝试将数据从一个工作表发布到另一个工作表。我在代码中定义了两个工作表,并将工作表范围放在一个数组中。然后我想创建一个循环,如果 D 列的数字为 3 或更高,则该循环将从我的业务表中的业务表中的 E 列中发布数据。但是,当我运行它时,它说

Subscript is out if range

我的代码如下


Sub Simple_if2()
 Dim shB As Worksheet, shE As Worksheet, lastRB As Long, lastRE As Long
 Dim score As Integer, i As Long, k As Long, arrB  As Variant

'Worksheet definitions
 Set shB = Worksheets("Business")
 Set shE = Worksheets("Engagement Plan (High Priority)")
 
 lastRB = shB.Range("D" & shB.Rows.Count).End(xlUp).Row
 lastRE = shB.Range("E" & shB.Rows.Count).End(xlUp).Row
 arrB = shB.Range("D6:E6" & lastRB & lastRE).Value  'put the shB sheet range in an array
 ReDim arrE(UBound(arrB))      'redim arrE at maximum possible dimension

 
 'Loop for Business worksheet
 For i = 1 To UBound(arrB)
    If arrB(2, i) >= 3 Then
        arrE(k) = arrB(1, i) 'fill arrE only with elements >=3
        k = k + 1
    End If
 Next i
 
 
 ReDim Preserve arrE(k + 1)  'redim the array to keep only the filled elements

 'drop the array content at once:
 shE.Range("B3").Resize(UBound(arrE) + 1, 1).Value = WorksheetFunction.Transpose(arrE)
End Sub

标签: arraysexcelvbarange

解决方案


  1. 交换2andi3and i: arrB(i, 1)andarrB(i, 2)
  2. 在将范围读.Value入数组之前更正范围的引用:shB.Range("D6:E" & lastRE).Value
 Dim shB As Worksheet, shE As Worksheet, lastRB As Long, lastRE As Long
 Dim score As Integer, i As Long, k As Long, arrB  As Variant

'Worksheet definitions
 Set shB = Worksheets("Business")
 Set shE = Worksheets("Engagement Plan (High Priority)")

 lastRB = shB.Range("D" & shB.Rows.Count).End(xlUp).Row
 lastRE = shB.Range("E" & shB.Rows.Count).End(xlUp).Row
 arrB = shB.Range("D6:E" & lastRE).Value 'put the shB sheet range in an array
 ReDim arrE(UBound(arrB))      'redim arrE at maximum possible dimension


 'Loop for Business worksheet
 For i = 1 To UBound(arrB)
    If arrB(i, 1) >= 3 Then
        arrE(k) = arrB(i, 2) 'fill arrE only with elements >=3
        k = k + 1
    End If
 Next i


 ReDim Preserve arrE(k + 1)  'redim the array to keep only the filled elements

 'drop the array content at once:
 shE.Range("B3").Resize(UBound(arrE) + 1, 1).Value = WorksheetFunction.Transpose(arrE)
End Sub


推荐阅读