Не выполняется функция VBA в Excel

Question

Не выполняется функция VBA в Excel

Рейтинг: 0Ответов: 1Опубликовано: 21.03.2023

Excel при первом вводе функции выдает ошибку: "Приложению Microsoft Excel не удается вычислить формулу. В открытой книге обнаружена циклическая ссылка, однако не получается отобразить источник ошибки. Попробуйте изменить последнюю введенную формулу или удалите ее с помощью команды "Отменить"."

Сам код:

Function GenerateCode(inputer As String) As String

Dim words() As String
Dim lastRow As Long
Dim i As Long
Dim firstLetters As String
Dim code As Integer

'inputer = Range("C1").Value

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

words = Split(inputer, " ")

If UBound(words) < 1 Then
    GenerateCode = ""
Else
    firstLetters = UCase(Left(words(0), 1)) & UCase(Left(words(1), 1)) ' объединяем первые буквы слов в верхнем регистре
End If
code = 1
 'проверяем наличие записи с таким же кодом в столбце A
For i = 1 To lastRow
    If Range("A" & i).Value = "УЦ-" & firstLetters & "-" & code Then
        code = code + 1 ' добавляем 1, если запись с таким кодом уже существует
        Else
        'End Function
    End If
Next i

GenerateCode = "УЦ-" & firstLetters & "-" & CStr(code)
End Function

Выяснил, что ошибка в блоке после: 'проверяем наличие записи с таким же кодом в столбце A

Если сделать это не функцией, а макросом, то работает, догадываюсь, что нельзя в функции использовать условия.

excel vba

Источник: Stack Overflow на русском

Answer 1

▲ 0

Это не лучшее решение- на скорую руку, но работать будет:

Function GenerateCode(inputer As String) As String
Dim words() As String
Dim lastRow As Long
Dim i As Long
Dim firstLetters As String
Dim code As Integer

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

words = Split(inputer, " ")

If UBound(words) < 1 Then
    GenerateCode = ""
Else
    firstLetters = UCase(Left(words(0), 1)) & UCase(Left(words(1), 1)) 'объединяем первые буквы слов в верхнем регистре
End If
code = 1
 'Ищем максимальный код
Dim MaxCode As Long: MaxCode = 0
For i = 2 To lastRow
    Dim CurrentCode As String: CurrentCode = CStr(Cells(i, 1).Value)
    Dim NumericCode As String
    If InStr(4, CurrentCode, "-") > 0 Then
        NumericCode = Right(CurrentCode, Len(CurrentCode) - InStr(4, CurrentCode, "-"))
        If IsNumeric(NumericCode) Then
            If CLng(NumericCode) > MaxCode Then
                MaxCode = CLng(NumericCode)
            End If
        End If
    End If
Next i
MaxCode = MaxCode + 1
GenerateCode = "УЦ-" & firstLetters & "-" & CStr(MaxCode)
End Function

'Процедура, которую надо вызывать по кнопке или по завершению редактирования ячейки "C"
Sub FillCode()
    lastRow = Cells(Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRow
        If Trim(CStr(Cells(i, 3))) <> "" And Trim(CStr(Cells(i, 1))) = "" Then
            Cells(i, 1) = GenerateCode(Trim(CStr(Cells(i, 3))))
        End If
    Next i
End Sub

FillCode вызываете по нажатию кнопки или по завершению редактирования колонки "C".

Не выполняется функция VBA в Excel

Ответы