Объединение VBA и формул для проверки уникального вывода - PullRequest
Новая
       17

Объединение VBA и формул для проверки уникального вывода

2 голосов
/ 14 ноября 2011

Хорошо, у меня есть эта формула, которая генерирует имена пользователей на основе списка имен и фамилий.Теперь, пока это работает, я хочу, чтобы ячейки ссылались на мою собственную функцию VBA.Но я все еще хочу использовать оригинальную формулу из-за гораздо меньшего количества кода.

У меня есть эта формула: 

=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(table[[#This Row];[Firstname:]])&table[[#This Row];[Lastname:]]);"æ";"a");"ø";"o");"å";"a")

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

Я думал что-то вроде этого: 

Public Function genUserName(ByVal strFirstName, strLastName As String)
    Dim strUsername As String

    Set objDomain = GetObject("WinNT://grunnarbeid2.local")
    objDomain.Filter = Array("User")

    'FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]]);""æ"";""a"");""ø"";""o"");""å"";""a"")"
    'strUsername = ActiveCell.FormulaR1C1


    blnFound = False

    For Each objUser In objDomain
        If objUser.Name = strUsername Then
            blnFound = True
        Exit For
        End If
    Next

    genUserName = strUsername

End Function

Итак, как мне объединить это?

1 Ответ

2 голосов
/ 14 ноября 2011

Я бы предложил ограничить функциональность genUserName только проверкой уникальности и передать в нее результат вашей существующей формулы: 

Public Function genUserName(ByVal strUsername As String)
    Set objDomain = GetObject("WinNT://grunnarbeid2.local")
    objDomain.Filter = Array("User")
    blnFound = False
    For Each objUser In objDomain
        If objUser.Name = strUsername Then
            blnFound = True
            Exit For
        End If
    Next
    genUserName = strUsername
End Function

затем позвоните из клетки, как 

=genUserName(SUBSTITUTE( ... ))
...