Diese Funktion zerlegt einen String in eine feste Anzahl Teile.
Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r()
'Ein String mit 9 Zeichen in 3 Teile zerlegen print_r strChunk("abcdefghi", 3) <String()> ( [0] => <String> 'abc' [1] => <String> 'def' [2] => <String> 'ghi' ) 'Dieses mal sind es nur 7 Zeichen. Der letzte Teil ist somit kürzer print_r strChunk("abcdefg", 3) <String()> ( [0] => <String> 'abc' [1] => <String> 'def' [2] => <String> 'g' ) 'Es sind mehr Teile als Zeichen. print_r strChunk("ab", 3) <String()> ( [0] => <String> 'a' [1] => <String> 'b' [2] => <String> '' ) '4 Zeichen kann man nicht regelmässig auf 3 Teile zerlegen. Darum sind die letzten 2 Teile verkürzt print_r strChunk("abcd", 3) <String()> ( [0] => <String> 'ab' [1] => <String> 'c' [2] => <String> 'd' ) 'Ein Leerer String print_r strChunk("", 3) <String()> ()
Attribute VB_Name = "udf_strChunk" '------------------------------------------------------------------------------- 'File : udf_strChunk.bas ' Copyright mpl by ERB software ' All rights reserved ' http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/strChunk 'Environment : VBA 2010 + 'Version : 1.0.0 'Name : strChunk 'Author : Stefan Erb (ERS) 'History : 02.06.2014 - ERS - Creation '------------------------------------------------------------------------------- Option Explicit '/** ' * Zerteilt ein String in eine Anzahl Teile ' * @param String String, der zerlegt werden soll ' * @param Integer Anzahl Teile ' * @return Array<String> ' */ Public Function strChunk(ByVal iString As String, ByVal iCount As Integer) As String() If Len(iString) = 0 Then Exit Function Dim size As Integer: size = (Len(iString) \ iCount + IIf(Len(iString) Mod iCount > 0, 1, 0)) Dim retArr() As String: ReDim retArr(iCount - 1) Dim i As Integer: For i = 0 To iCount - 1 retArr(i) = Mid(iString, (i * size) + 1, size) Next i 'Wenn der letzte Teil leer ist, den Zweitletzten Teil aufteilen 'zB len(iString) = 4, iCount=3 'Wenn der 2t letzte Eintrag bereits nur ein Zeichen lang ist, dann ist halt der letzte dann leer i = iCount - 1 If retArr(i) = Empty And Len(retArr(i - 1)) > 1 Then Dim corr() As String: corr = strChunk(retArr(i - 1), 2) retArr(i - 1) = corr(0) retArr(i) = corr(1) End If strChunk = retArr End Function