解决尝试在 Excel VBA 代码中将值分配给范围变量的错误

Question

我正在编写一个程序来从工作表中的值生成多个命名范围，单元格在 C 列中命名，名称在 D 列的相邻单元格中分配。我尝试过的所有变体将这两个单元格作为范围引用返回错误。虽然此过程将只使用一次来生成这些名称，但我想确定正确的语法，以便将来能够引用范围用于其他目的。

我有一个临时的 ActiveX 命令按钮，它调用以下代码（现在仅引用两行用于测试目的）：

Private Sub CommandButton1_Click()
    Call SetRangeNames(38, 39)
End Sub

根据我在其他地方看到的帖子中的建议，我将 SetRangeNames 过程放置在一个模块中。两行代码返回错误由过程代码中的注释指示，我尝试过的所有变体（以及它们返回的错误）都遵循这一点。我在 proc 中放置了一个 MsgBox 调用，以查看它是如何渲染生成的单元格引用的。它显示：

rangeNameValueCellAddress = "C38"; namedRangeCellAddress = "D38"

或

rangeNameValueCellAddress = "C39"; namedRangeCellAddress = "D39"

这是 proc 的一种变体：

Public Sub SetRangeNames(startRow As Integer, endRow As Integer)
    Dim theRange As Range
    Dim currentRow As Integer
    Dim currentName As String
    Dim rangeNameValueCellAddress As String
    Dim namedRangeCellAddress As String

    For currentRow = startRow To endRow
        rangeNameValueCellAddress = """D" & Trim(Str(currentRow) & """")
        namedRangeCellAddress = """C" & Trim(Str(currentRow) & """")
        MsgBox ("rangeNameValueCellAddress = " & rangeNameValueCellAddress & _
            "; namedRangeCellAddress = " & namedRangeCellAddress)
        'MsgBox displays: rangeNameValueCellAddress = "C38"; namedRangeCellAddress = "D38"
        ' or: rangeNameValueCellAddress = "C39"; namedRangeCellAddress = "D39"
        '*** The following two statements return errors:
        Set theRange = ThisWorkbook.Worksheets(ActiveSheet).Range(namedRangeCellAddress)
        currentName = ThisWorkbook.Worksheets(ActiveSheet).Range(rangeNameValueCellAddress).Value2
        ActiveWorkbook.Names.Add Name:=currentName, RefersTo:=theRange
    Next currentRow
End Sub

以下是我尝试过的变体（“SYSProjectData”既是名称，又是我正在使用的工作表的代码名称和名称）：

Set theRange = SYSProjectData.Range(namedRangeCellAddress)
currentName = SYSProjectData.Range(rangeNameValueCellAddress).Value2

返回：“应用程序定义的或对象定义的错误”

Set theRange = ThisWorkbook.SYSProjectData.Range(namedRangeCellAddress)
currentName = ThisWorkbook.SYSProjectData.Range(rangeNameValueCellAddress).Value2

返回：“对象不支持此属性或方法”

Set theRange = ThisWorkbook.ActiveSheet.Range(namedRangeCellAddress)
currentName = ThisWorkbook.ActiveSheet.Range(rangeNameValueCellAddress).Value2

返回：“应用程序定义的或对象定义的错误”

Set theRange = ActiveSheet.Range(namedRangeCellAddress)
currentName = ActiveSheet.Range(rangeNameValueCellAddress).Value2

返回：“应用程序定义的或对象定义的错误”

Set theRange = ThisWorkbook.Worksheets(SYSProjectData).Range(namedRangeCellAddress)
currentName = ThisWorkbook.Worksheets(SYSProjectData).Range(rangeNameValueCellAddress).Value2 

返回：“类型不匹配”

Set theRange = ThisWorkbook.Worksheets("SYSProjectData").Range(namedRangeCellAddress)
currentName = ThisWorkbook.Worksheets("SYSProjectData").Range(rangeNameValueCellAddress).Value2 

返回：“应用程序定义的或对象定义的错误”

Set theRange = ThisWorkbook.Sheets(SYSProjectData).Range(namedRangeCellAddress)
currentName = ThisWorkbook.Sheets(SYSProjectData).Range(rangeNameValueCellAddress).Value2

返回：“类型不匹配”

Set theRange = ThisWorkbook.Sheets("SYSProjectData").Range(namedRangeCellAddress)
currentName = ThisWorkbook.Sheets("SYSProjectData").Range(rangeNameValueCellAddress).Value2

返回：“应用程序定义的或对象定义的错误”

Set theRange = ThisWorkbook.Sheets(ActiveSheet).Range(namedRangeCellAddress)
currentName = ThisWorkbook.Sheets(ActiveSheet).Range(rangeNameValueCellAddress).Value2

返回：“类型不匹配”

Set theRange = ThisWorkbook.Worksheets(ActiveSheet).Range(namedRangeCellAddress)
currentName = ThisWorkbook.Worksheets(ActiveSheet).Range(rangeNameValueCellAddress).Value2

返回：“类型不匹配”

谁能告诉我我做错了什么？

谢谢！

Answer 1

你应该可以做这样的事情：

Public Sub SetRangeNames(startRow As Integer, endRow As Integer)

    Dim currentRow As Long 'Long not Integer (always safer)

    For currentRow = startRow To endRow

        With ThisWorkbook.Sheets("SYSProjectData")
            'worksheets Parent is the containing workbook
            .Parent.Names.Add Name:=.Cells(currentRow, "D"), _
                                     RefersTo:=.Cells(currentRow, "C")
        End With

    Next currentRow
End Sub

Answer 2

这是你的代码，有问题的地方注释

'Public Sub SetRangeNames(startRow As Integer, endRow As Integer)
'    Better to use Long
Public Sub SetRangeNames(startRow As Long, endRow As Long)

    Dim theRange As Range
    Dim currentRow As Long ' Integer
    Dim currentName As String
    Dim rangeNameValueCellAddress As String
    Dim namedRangeCellAddress As String

    For currentRow = startRow To endRow
        'rangeNameValueCellAddress = """D" & Trim(Str(currentRow) & """")
        '  Don't include " in the string value.
        '  No need for Trim(Str(
        rangeNameValueCellAddress = "D" & currentRow

        'namedRangeCellAddress = """C" & Trim(Str(currentRow) & """")
        namedRangeCellAddress = "C" & currentRow

        MsgBox ("rangeNameValueCellAddress = " & rangeNameValueCellAddress & _
            "; namedRangeCellAddress = " & namedRangeCellAddress)
        '*** The following two statements return errors:

        'Set theRange = ThisWorkbook.Worksheets(ActiveSheet).Range(namedRangeCellAddress)
        '  ActiveSheet is already a worksheetsheet
        Set theRange = ActiveSheet.Range(namedRangeCellAddress)

        currentName = ActiveSheet.Range(rangeNameValueCellAddress).Value2

        ActiveWorkbook.Names.Add Name:=currentName, RefersTo:=theRange
    Next currentRow
End Sub

这是另一种方法，请参阅内联 cmets

Private Sub CommandButton2_Click()
    SetRangeNames2 ActiveSheet.Range("C8")
End Sub

Public Sub SetRangeNames2(startCell As Range)
    Dim Nm As Name
    Dim Dat As Variant
    Dim i As Long

    With startCell.Worksheet
        ' Copy data to Variant array, for speed
        Dat = .Range(startCell, .Cells(.Rows.Count, startCell.Column).End(xlUp)).Resize(, 2).Value2

        '  Loop the array
        For i = 1 To UBound(Dat, 1)
            ' Check if name already exists
            Set Nm = Nothing
                On Error Resume Next
            Set Nm = .Names(Dat(i, 2))
            On Error GoTo 0
            If Nm Is Nothing Then
                ' Add name
                .Parent.Names.Add Name:=Dat(i, 2), RefersTo:=.Range(Dat(i, 1))
            Else
                ' Name Already exists, update it
                Nm.RefersToRange = .Range(Dat(i, 1))
            End If
        Next
    End With
End Sub

Answer 3

很抱歉延迟发布此内容。这就是我最终的结果......

Public Sub SetRangeNames(strNamedRangeColumn As String, strNameSourceColumn As String, startRow As Long, endRow As Long)
    Dim currentRow As Long
    Dim rngNameSourceCell As Range
    Dim rngNamedRangeCell As Range
    Dim strNameSourceCellAddress As String
    Dim strNamedRangeCellAddress As String
    Dim strNameSourceCellValue As String
    Dim strNamedRangeCellValue As String
    Dim strRangeValueError As String

    strRangeValueError = ""
    strNamedRangeColumn = Trim(UCase(strNamedRangeColumn))
    strNameSourceColumn = Trim(UCase(strNameSourceColumn))

    If Len(strNamedRangeColumn) > 1 Then
        MsgBox ("ERROR: The value given for the named range column, """ & strNamedRangeColumn & _
            ","" was longer than one character.")
        Exit Sub
    ElseIf Len(strNameSourceColumn) > 1 Then
        MsgBox ("ERROR: The value given for the name source column, """ & strNameSourceColumn & _
            ","" was longer than one character.")
        Exit Sub
    ElseIf strNamedRangeColumn = "" Then
        MsgBox ("ERROR: The value given for the named range column was longer than one character.")
        Exit Sub
    ElseIf strNameSourceColumn = "" Then
        MsgBox ("ERROR: The value given for the name source column was longer than one character.")
        Exit Sub
    ElseIf Asc(strNamedRangeColumn) < 65 Or Asc(strNamedRangeColumn) > 90 Then
        MsgBox ("ERROR: The value given for the named range column, """ & strNamedRangeColumn & _
            ","" was not a letter.")
        Exit Sub
    ElseIf Asc(strNameSourceColumn) < 65 Or Asc(strNameSourceColumn) > 90 Then
        MsgBox ("ERROR: The value given for the name source column, """ & strNameSourceColumn & _
            ","" was not a letter.")
        Exit Sub
    End If

    For currentRow = startRow To endRow
        strNameSourceCellAddress = strNameSourceColumn & Trim(str(currentRow))
        strNamedRangeCellAddress = strNamedRangeColumn & Trim(str(currentRow))
        Set rngNameSourceCell = Range(strNameSourceCellAddress)
        Set rngNamedRangeCell = Range(strNamedRangeCellAddress)

        strNameSourceCellValue = Trim(rngNameSourceCell.Value)

        If IsEmpty(rngNameSourceCell) Or Len(strNameSourceCellValue) > 0 Then
                strRangeValueError = "Source cell " & strNameSourceCellAddress & " was empty."
        End If

        If Not (Application.WorksheetFunction.IsText(rngNameSourceCell.Value)) Then
                If Len(strRangeValueError) > 0 Then
                        strRangeValueError = vbCrLf & strRangeValueError
                End If
                strRangeValueError = strRangeValueError & "Source cell " & strNameSourceCellAddress & _
                    " contained the not-text value """ & strNameSourceCellValue & """."
        End If

        If Len(strRangeValueError) > 0 Then
                MsgBox (strRangeValueError)
                Exit Sub
        End If

        ThisWorkbook.sheets("mySheetName").Parent.Names.Add Name:=.Cells(currentRow, strNameSourceColumn), _
            RefersTo:=.Cells(currentRow, strNamedRangeColumn)

    Next currentRow
End Sub

如下调用...

Private Sub btnGenerateRangeNames_Click()
    Call SetRangeNames("C", "E", 8, 11)
    ' etc.
End Sub

感谢您的帮助！