Excel VBA – zawijanie wierszy (rozdzielanie łańcuchów znaków)

No Comments

W dzisiejszym wpisie zajmiemy się stringami. Ale nie cieszcie się za bardzo.

Napotkałem ciekawy problem w pewnym wspaniałym systemie pewnej wspaniałej polskiej firmy. W danych do faktury nazwa podmiotu miała trzy linijki – były to trzy osobne pola o maksymalnej długości 50 znaków. Głupota, ale co ja tam wiem.

Klient wpisując dane do faktury w sklepie internetowym miał na nazwę jedno pole, co jest bardziej sensowne. No i trafiliśmy w końcu na kogoś, kto miał nazwę dłuższą niż 50 znaków, co spowodowało kupę śmiechu… dobra, spowodowało to ochrzan biednego WRonX’a. Trzeba było sobie z tym jakoś poradzić

Co chcemy zrobić? Chcemy rozbić długiego stringa na kilka mniejszych. Ale żeby było ładniej, chcemy go rozbić w konkretnych miejscach – dokładniej w miejscu spacji.

Nie będę tłumaczył po kolei, jak to działa, bo dodałem tyle komentarzy, że funkcja jest dwukrotnie dłuższa, niż była. Miłego korzystania:

 

Function wrapString(longString As String, maxLen As Integer) As String()
    Dim strArr() As String
    ReDim Preserve strArr(0)
 
    ' jesli nie trzeba rozbijac, bo podany string jest krotszy, niz
    ' maksymalna dlugosc linijki:
    If Len(longString)  maxLen Then
                strArr(actualIndex) = Mid(tmpArr(i), 1, maxLen)
                ' powieksz tablice, skocz do nowej linii
                actualIndex = actualIndex + 1
                ReDim Preserve strArr(actualIndex)
                ' obcinamy poczatek "wyrazu"
                tmpArr(i) = Mid(tmpArr(i), maxLen, Len(tmpArr(i)) - maxLen + 1)
                ' wroc do tego samego "wyrazu" przy nastepnym przebiegu petli
                i = i - 1
                GoTo continueLoop ' nienawidze VBA... GoTo Hell!
            End If
            ' "wyraz" ma dobra dlugosc, a linia jest pusta, bezposrednie przypisanie
            strArr(actualIndex) = tmpArr(i)
            i = i + 1
            If i > UBound(tmpArr) Then GoTo continueLoop ' a fe...
        End If
 
        ' czy mozemy jeszcze dodac kolejny "wyraz" do aktualnej linii?
        If Len(strArr(actualIndex) & " " & tmpArr(i)) > maxLen Then
            ' powieksz tablice, skocz do nowej linii
            actualIndex = actualIndex + 1
            ReDim Preserve strArr(actualIndex)
            ' wroc do tego samego "wyrazu" przy nastepnym przebiegu petli
            i = i - 1
        Else
            ' mozna dokleic na koncu linii
            strArr(actualIndex) = strArr(actualIndex) & " " & tmpArr(i)
        End If
continueLoop: ' die, VBA! DIE!
    Next i
 
    ' oszczędność przede wszystkim
    For i = LBound(strArr) To UBound(strArr): strArr(i) = Trim(strArr(i)): Next i
 
    wrapString = strArr ' yeaaa...
End Function

 

Leave a Reply

Your email address will not be published. Required fields are marked *