====== [VBA] strChunk() ======
Diese Funktion zerlegt einen String in eine feste Anzahl Teile.
{{:vba:functions:udf_strchunk.bas|Download udf_strChunk.bas}}
===== Beispiele =====
{{section>:snippets#vba_print_r&noheader&firstseconly}}
'Ein String mit 9 Zeichen in 3 Teile zerlegen
print_r strChunk("abcdefghi", 3)
(
[0] => 'abc'
[1] => 'def'
[2] => 'ghi'
)
'Dieses mal sind es nur 7 Zeichen. Der letzte Teil ist somit kürzer
print_r strChunk("abcdefg", 3)
(
[0] => 'abc'
[1] => 'def'
[2] => 'g'
)
'Es sind mehr Teile als Zeichen.
print_r strChunk("ab", 3)
(
[0] => 'a'
[1] => 'b'
[2] => ''
)
'4 Zeichen kann man nicht regelmässig auf 3 Teile zerlegen. Darum sind die letzten 2 Teile verkürzt
print_r strChunk("abcd", 3)
(
[0] => 'ab'
[1] => 'c'
[2] => 'd'
)
'Ein Leerer String
print_r strChunk("", 3)
()
===== Code =====
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
' */
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