VBA поменять слова в строке

Question

В VBA я создал пользовательскую форму. Он содержит несколько текстовых полей, в которые пользователь может писать текст. В одном текстовом поле пользователь должен ввести свою фамилию. Я сделал переменную с именем lastname, а затем сделал lastname = LastnameBox.Value.

Мой вопрос:
Если кто-то, например, напечатает de Vries, как я могу изменить это в Vries, de Или, если кто-то наберет van de Voort van Zijp, мне нужно изменить это на Voort van Zijp, van de.

Как я мог сделать это возможным в VBA?

Answer 1

Я бы попробовал что-то в этом духе. Не знаю, как вы требуете разделения, я использовал "де", как это

    Function NamesTest(strNameIn As String)

Dim a() As String

a = Split(strNameIn, "de")

a(0) = a(0) & " de"

NamesTest = a(1) & "," & a(0)

End Function

Answer 2

Вот более универсальное решение для проблемы, указанной в заголовке (не будет обрабатывать особенности инвертирования имени / фамилии, что является другой проблемой):

Public Function ReverseWords(ByVal value As String) As String

    Dim words As Variant
    words = VBA.Strings.Split(value, " ")

    Dim result As String, i As Long
    For i = LBound(words) To UBound(words)
        result = words(i) & " " & result
    Next

    ReverseWords = result

End Function

Использование:

Debug.Print ReverseWords("the quick brown fox jumps over the lazy dog")

Выходы:

dog lazy the over jumps fox brown quick the 

---

Тем не менее, для ОП речь вовсе не идет об инверсии слов в строке. Решение состоит в том, чтобы разобрать заданную строку.

Первая заглавная буква действительно там, где я хочу поменяться

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

Это работает:

Public Function ReverseFullName(ByVal value As String) As String

    Dim firstCapitalIndex As Long, i As Long
    For i = 1 To Len(value)
        If IsCapitalLetter(Mid$(value, i, 1)) Then
            firstCapitalIndex = i
            Exit For
        End If
    Next

    If i = 1 Then
        'already shaped as needed
        ReverseFullName = value
        Exit Function
    End If

    Dim firstName As String
    firstName = Trim$(Left$(value, firstCapitalIndex - 1))

    Dim lastName As String
    lastName = Trim$(Mid$(value, firstCapitalIndex))

    ReverseFullName = lastName & ", " & firstName

End Function

Private Function IsCapitalLetter(ByVal value As String) As Boolean
    Dim asciiCode As Integer
    asciiCode = Asc(value)
    IsCapitalLetter = asciiCode >= Asc("A") And asciiCode <= Asc("Z")
End Function

Использование:

Debug.Print ReverseFullName("van de Voort van Zijp")
Debug.Print ReverseFullName("de Vries")
Debug.Print ReverseFullName("Voort van Zijp, van de")

Выходы:

Voort van Zijp, van de
Vries, de
Voort van Zijp, van de

Answer 3

Вот два варианта. Первый подберет последнее слово и сделает обмен. Не обращает внимания на регистр букв.

Sub LastFirst()

    Debug.Print RevLast("de Vries")
    Debug.Print RevLast("van der Straat")
    Debug.Print RevLast("van de drake")

End Sub
Function RevLast(Name)

    LastName = Trim(Right(Replace(Name, " ", String(99, " ")), 99))
    LenLastName = Len(LastName)
    FirstPart = Left(Name, Len(Name) - (LenLastName + 1))
    RevLast = LastName + ", " + FirstPart

End Function

На втором месте только строчные буквы.

Sub UppercaseFirst()

    Name = "de Vries"
    Name = "van der Straat"
    Debug.Print RevUpper("de Vries")
    Debug.Print RevUpper("van der Straat")
    Debug.Print RevUpper("van de drake")

End Sub

Function RevUpper(Name)

    FirstUpper = -1
    On Error Resume Next
    xStr = Trim(Rg.Value)
    For j = Len(Name) To 1 Step -1
        If (Asc(Mid(Name, j, 1)) < 91) And (Asc(Mid(Name, j, 1)) > 64) Then
            FirstUpper = Len(Name) - j + 1
            Exit For
        End If
    Next

    If FirstUpper > 0 Then
        LastName = Right(Name, FirstUpper)
        FirstPart = Left(Name, Len(Name) - (FirstUpper + 1))
        NewName = LastName + ", " + FirstPart
        RevUpper = NewName
    Else
        RevUpper = "Invalid"
    End If

End Function

Function RevNm(Name)

    FirstUpper = -1
    On Error Resume Next
    xStr = Trim(Rg.Value)
    For j = Len(Name) To 1 Step -1
        If (Asc(Mid(Name, j, 1)) < 91) And (Asc(Mid(Name, j, 1)) > 64) Then
            FirstUpper = Len(Name) - j + 1
            Exit For
        End If
    Next

    If FirstUpper > 0 Then
        LastName = Right(Name, FirstUpper)
        FirstPart = Left(Name, Len(Name) - (FirstUpper + 1))
        NewName = LastName + ", " + FirstPart
        RevNm = NewName
    Else
        RevNm = "Invalid"
    End If


End Function