Устранение ошибок при попытке присвоить значения переменным диапазона в коде Excel VBA

Question

Я пишу процедуру для генерации ряда именованных диапазонов из значений на листе, с ячейкой, которая будет названа в столбце C, и именем, которое будет назначено в соседней ячейке в столбце D. Все варианты, которые я пробовал ссылаться на эти две ячейки как на диапазоны возвращаемых ошибок. Хотя эта процедура будет использоваться только один раз для генерации этих имен, я хотел бы определить правильный синтаксис, чтобы в будущем я мог ссылаться на диапазоны для других целей.

У меня есть временная ActiveX CommandButton, которая вызывает следующий код (сейчас для целей тестирования просто ссылка на две строки):

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

Я поместил процедуру SetRangeNames в модуль, основываясь на рекомендациях в постах, которые я видел в других местах. Две строки кода, возвращающие ошибки, обозначаются комментарием внутри кода процедуры, и все варианты, которые я пробовал (с ошибками, которые они возвращают), следуют этому. Я поместил вызов MsgBox в proc, чтобы посмотреть, как он рендерит сгенерированные ссылки на ячейки Отображает:

rangeNameValueCellAddress = "C38"; namedRangeCellAddress = "D38"

или

rangeNameValueCellAddress = "C39"; namedRangeCellAddress = "D39"

Вот одна из вариаций прока:

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» - это и имя, и CodeName, и имя рабочей таблицы, с которой я работаю):

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)
'    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

Вот альтернативный метод, см. Встроенные комментарии

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 2

Извините за задержку в публикации.Это то, чем я закончил ...

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

Спасибо за вашу помощь!

Answer 3

Вы должны быть в состоянии сделать что-то вроде этого:

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