Option Explicit
 
Private mArray() As String
Private bArray() As Byte
 
Private Sub Command1_Click()
 
   Dim s As String
 
      s = Array2String(mArray, vbCrLf, vbTab)
      ReDim bArray(Len(s) - 1)
      bArray = StrConv(s, vbFromUnicode)
 
      Text1.Text = s
      Text2.Text = s
End Sub
 
Private Sub Command2_Click()
 
   Dim s As String
   Dim i As Long, j As Long
 
      Text1.Text = ""
      Text2.Text = ""
 
      DoEvents
      MsgBox "go"
 
      Erase mArray
 
      s = StrConv(bArray, vbUnicode)
      Text2.Text = s
 
      mArray = String2Array(s, vbCrLf, vbTab)
 
      For i = 0 To UBound(mArray, 2)
         For j = 0 To UBound(mArray, 1)
            Text1.SelStart = Len(Text1.Text)
            Text1.SelText = mArray(j, i) & vbTab
         Next
         Text1.SelStart = Len(Text1.Text)
         Text1.SelText = vbCrLf
      Next
 
End Sub
 
Private Sub Form_Load()
 
   Dim wA() As String
 
      AddAdress mArray(), ";", "Müller;Heinrich;Osnabrück"
      AddAdress mArray(), ";", "Bauer;Ulrike;Hamburg"
      AddAdress mArray(), ";", "Schuster;Michael;Berlin"
 
      'muss gesetzt sein
      'Text1.MultiLine = True
End Sub
 
Public Sub AddAdress(mA() As String, Delimiter As String, Wert As String)
'Adressen in ein Array packen
 
   Dim s() As String
   Dim i As Long, j As Long, Index As Long
 
      s() = Split(Wert, Delimiter)
      If Not IsArrayDim(mA) Then
         ReDim mA(UBound(s), 0)
      Else
         Index = UBound(mA, 2) + 1
         ReDim Preserve mA(UBound(mA, 1), Index)
      End If
 
      For i = 0 To UBound(s)
         mA(i, Index) = s(i)
      Next
End Sub
 
Public Function IsArrayDim(mArray As Variant) As Boolean
'checkt ob ein Array dimensioniert ist
 
   Dim i As Long
 
      On Error GoTo Fehler
      i = LBound(mArray)
      IsArrayDim = True
 
Fehler:
End Function
 
Public Function Array2String(mA() As String, Delimiter1 As String, Delimiter2 _
  As String) As String
'2-dimensionales Array in String wandeln
 
   Dim wA() As String
   Dim s() As String, zw As String
   Dim i As Long, j As Long, z As Long
 
      '1-dimensionales Array erstellen
      ReDim wA(UBound(mA, 2))
      For i = LBound(mA, 2) To UBound(mA, 2)
         z = 0
         'Speicherplatz ermitteln
         For j = LBound(mA, 1) To UBound(mA, 1)
            z = z + Len(mA(j, i))
         Next
         'und bereitstellen
         zw = Space$(z + Len(Delimiter2) * (j - 1))
 
         'String erstellen aus Dimension 1
         z = 1
         For j = LBound(mA, 1) To UBound(mA, 1) - 1
            Mid$(zw, z) = mA(j, i) & Delimiter2
            z = z + Len(mA(j, i)) + Len(Delimiter2)
         Next
         If Len(mA(j, i)) > 0 Then
            Mid$(zw, z) = mA(j, i)
         End If
         'einfügen in Array
         wA(i) = zw
      Next
 
      'als String zurückgeben
      Array2String = Join(wA, Delimiter1)
End Function
 
Public Function String2Array(sString, Delimiter1, Delimiter2) As String()
'einen String in ein 2-dimensionales Array umsetzen
 
   Dim mA() As String
   Dim wA() As String
   Dim zA() As String
 
   Dim i As Long, j As Long
 
      'eindimensionales Array erstellen
      mA() = Split(sString, Delimiter1)
      i = UBound(Split(mA(LBound(mA)), Delimiter2))
 
      '2-dimensionales Array anlegen
      ReDim zA(i, UBound(mA))
 
      For i = LBound(mA) To UBound(mA)
         wA = Split(mA(i), Delimiter2)
         For j = 0 To UBound(mA)
            zA(j, i) = wA(j)
         Next
      Next
 
      String2Array = zA
End Function

- peter