根据条件创建命名范围时发生运行时错误

时间:2019-07-16 09:56:45

标签: excel vba

我有下面的代码通过一个表。当它在C列中找到“ Reporting”一词,在B列中找到“ OSI”一词时,它会为D和E-F列创建一个名为“ OSIRep”的范围,该行在B和C列中的条件均成立。

但是,当我将单词更改为“ Security”和“ OSI”以创建范围“ OSISec”时,出现错误,并且不知道为什么。错误是“运行时错误1004-对象'_Worksheet'的方法'Range'失败”,并且发生在sht.Range(sRng)

它要搜索的范围没有什么不同,我要创建的名称尚不存在,并且符合我的条件。有什么想法吗?

我试图保护工作表,解锁单元并浏览错误代码,但无济于事。

在此先感谢您提供的帮助或见解!

Set sht = ThisWorkbook.Worksheets("Features")

Set featuresRng = sht.Range(sht.Range("B1"), sht.Range("C" & sht.Rows.Count).End(xlUp))
rngArray = featuresRng
ReDim NewArr(1 To 1)
y = 1
For i = 1 To UBound(rngArray)
    If rngArray(i, 2) = "Reporting" And rngArray(i, 1) = "OSI" Then
        ReDim Preserve NewArr(1 To y)
        NewArr(y) = featuresRng.Rows(i).Resize(1, 3).Offset(0, 2).Address
        y = y + 1

    End If
Next i

sRng = Join(NewArr, Application.DecimalSeparator)
ThisWorkbook.Names.Add "OSIRep", sht.Range(sRng)

2 个答案:

答案 0 :(得分:2)

根据我的评论,Range仅接受255个字符的地址字符串,因此在循环时最好处理一个实际的Range对象:

For i = 1 To UBound(rngArray)
    If rngArray(i, 2) = "Reporting" And rngArray(i, 1) = "OSI" Then
         Dim OutputRange As Range
         If OutputRange Is Nothing Then
            Set OutputRange = featuresRng.Rows(i).Resize(1, 3).Offset(0, 2)
         Else
            Set OutputRange = Union(OutputRange, featuresRng.Rows(i).Resize(1, 3).Offset(0, 2))
         End If
    End If
Next i

If Not OutputRange Is Nothing Then OutputRange.Name = "OSIRep"

答案 1 :(得分:1)

您不需要featuresRng对象,因为您可以事先知道要处理的列,因此可以直接访问工作表。这是实现目标的有效方法:

Sub Macro1()
Dim sht As Worksheet, MySel As Range, rngArray As Variant, i As Long
Set sht = ThisWorkbook.Worksheets("Features")

With sht
    rngArray = .Range("B1", .Range("C" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(rngArray)
        If rngArray(i, 2) = "Reporting" And rngArray(i, 1) = "OSI" Then
            If MySel Is Nothing Then
                Set MySel = .Range("D" & i & ":F" & i)
            Else
                Set MySel = Application.Union(MySel, .Range("D" & i & ":F" & i))
            End If
        End If
    Next i
End With

If Not MySel Is Nothing Then MySel.Name = "OSIRep"
'Set MySel = Nothing
End Sub