Eine Tabelle "entfalten"
Dieses Programm verwandelt eine Tabelle, welche Mehrfachwerte aufweist, in eine Datenbanktabelle, also eine Tabelle, bei der jede Zelle nur einen einzigen Wert enthält.
Das folgende Bild zeigt eine Tabelle mit Mehrfachwerten in der dritten Spalte. Die einzelnen Werte sind durch Kommata voneinander getrennt. Eine solche Tabelle kann in Datenbanken schlecht verarbeitet werden.

Um diese Tabelle in eine datenbankkonforme Tabelle zu verwandeln, müssen wir sie „strecken“ bzw. „entfalten“. Hierzu fügen wir überall dort, wo mehrere Werte in einer Zelle stehen, für den zweiten und die weiteren Werte jeweils eine eigene Zeile ein. Aus einer Zeile mit drei Werten werden so drei Zeilen mit jeweils einem Wert. Das nächste Bild zeigt die so entfaltete Tabelle:

Aufruf und Benutzung des Programms
Auf dem Arbeitsblatt Start befindet sich eine Schaltfläche zum Starten des Programms. Rechts daneben steht ein kleiner Erklärungstext (in englischer Sprache).
Die umzuwandelnde Tabelle muss sich bereits auf einem Arbeitsblatt der aktuellen Arbeitsmappe befinden.

Hat der Benutzer die Schaltfläche mit der Aufschrift „Start Program“ angeklickt, so öffnet sich ein kleines Formular zur Eingabe der Parameter und zum Durchführen der Umwandlung (s. unten).
Das Bild zeigt das Formular nach der Eingabe, aber noch vor dem Drücken der Schaltfläche <Start unfolding the table>. Der Benutzer muss alle Eingabefelder ausfüllen, wobei es bei dem obersten Feld ausreicht, wenn er eine beliebige Zelle der umzuwandelnden Tabelle selektiert.

Hat der Benutzer die Schaltfläche gedrückt und war die anschließende Umwandlung erfolgreich, so wird eine diesbezügliche Meldung ausgegeben, welche der Benutzer quittieren muss (nächstes Bild). Konnte die Umwandlung nicht erfolgreich durchgeführt werden, so wird eine Fehlermeldung ausgegeben.

Der Aufbau des Programms
Das Programm hat eine zweischichtige Architektur:
·
- Die obere Schicht besteht aus dem Formular UnfoldGForm und dem dazu gehörigen Formularmodul.
- Die untere Schicht ist dreigeteilt. Das Modul Unfold enthält den Programmkern in Form der Funktion unfoldTableG, welche die Umwandlung durchführt. Ebenfalls zur unteren Schicht gehören das Modul ValHlp, in dem sich allgemein verwendbare Funktionen zur Eingabenvalidierung befinden, und das Modul Hlp, das hier nur aus einer Funktion besteht, welche das Vorhandensein eines Arbeitsblatts bestimmten Namens überprüft.
Der Code der Funktion unfoldTableG im Modul Unfold
Vom Modul Unfold betrachten wir hier nur die Funktion unfoldTableG und die Deklaration des Datentyps uRow, welcher in dieser Funktion benutzt wird. Dieser Datentyp enthält lediglich ein unbestimmtes Array Typ Variant. In der Funktion wird daraus durch ein ReDim ein eindimensionales Array, das genau eine Zeile aus der Tabelle aufnehmen kann. Wir speichern und bearbeiten die Tabelle in einem Array d vom Typ uRow, also in einem Array von Arrays (geschachteltes Array).
Weshalb nehmen wir nicht einfach ein zweidimensionales Array zur Darstellung der Tabelle? Das Problem ist, dass wir der Originaltabelle Zeilen hinzufügen müssen, wenn wir sie „entfalten“. VBA sieht zum Erweitern eines bereits teilweise mit Werten gefüllten Arrays die Anweisung ReDim Preserve vor. Diese Anweisung kann aber nur auf die letzte Dimension des Arrays angewandt werden. Hier müssen wir aber die Zeilendimension, also die erste Dimension erweitern.
Im zweiten Teil der Funktion wird dann das geschachtelte Array d in ein zweidimensionales Array r überführt, also „entschachtelt“. Damit beschränken wir die Arbeit mit dem geschachtelten Array auf das Modul Unfold und belasten nicht die aufrufende Stelle damit.
'used in unfoldTableG
Type uRow
r() As Variant
End Type
'Unfolds a table, which means that a table having a column with
'multiple comma-separated values is converted to a longer table
'where each cell has only one value
Public Function unfoldTableG(ByVal fld As Range, _
ByVal fColNo As Integer) As Variant
Dim d() As uRow 'rows of the table
Dim u() As String 'for the items in column fColNo
Dim r() As Variant 'unnested table (result)
Dim i As Long, j As Long, rCount As Long, k As Integer
Dim tmp As String
'data are collected in d
'--------------------------------
rCount = fld.Rows.Count 'number of rows at the beginning
ReDim d(1 To rCount)
For i = 1 To rCount
ReDim d(i).r(1 To fld.Columns.Count)
Next i
For i = 1 To fld.Rows.Count
'insert row into d
For j = 1 To fld.Columns.Count
d(i).r(j) = fld(i, j)
Next j
'add rows for additional items in folded field
If i > 1 And fld(i, fColNo) <> "" Then
'save value in column fColNo
tmp = CStr(fld(i, fColNo).Value)
'get items & replace value in original row
u = Split(tmp, ",", -1)
d(i).r(fColNo) = CVar(u(0))
'if there is more than one item, add rows
If UBound(u) > 0 Then
For k = 1 To UBound(u)
'extend d
rCount = rCount + 1
ReDim Preserve d(1 To rCount)
ReDim d(rCount).r(1 To fld.Columns.Count)
'copy values from original table
For j = 1 To fld.Columns.Count
d(rCount).r(j) = fld(i, j)
Next j
'correct value in column fColNo
d(rCount).r(fColNo) = CVar(Trim(u(k)))
Next k
End If
End If
Next i
'data are transferred from d to r ("unnested")
'---------------------------------------------------------------
ReDim r(1 To rCount, 1 To fld.Columns.Count)
For i = 1 To rCount
For j = 1 To fld.Columns.Count
r(i, j) = d(i).r(j)
Next j
Next i
unfoldTableG = r
End Function
Der Code des Formularmoduls UnfoldGForm
Die Verarbeitung der Eingaben geschieht in der Ereignisprozedur StartBtn_Click. Diese Prozedur bedient sich der Funktion ValidierungOK, um einen Teil der Eingaben zu validieren. Schwieriger als die Namen der Spalten und des Ziel-Arbeitsblatts ist jedoch die Eingabe des Bereichs zu validieren, in dem sich die zu entfaltende Tabelle befindet. Deshalb werden Fehler, die aus falschen Eingaben dieses Bereichs beruhen, pauschal mit On Error GoTo abgefangen.
Das Modul ValHlp wird aus der Funktion ValidierungOK heraus benutzt, um die Zulässigkeit des zweiten und des dritten Parameters des Formulars zu überprüfen.
In StartBtn_Click wird vor dem Ausschreiben des Ergebnisses noch mit Hilfe der Funktion wrkshExists ermittelt, ob sich das Arbeitsblatt, auf das ausgegeben werden soll, bereits in der Arbeitsmappe befindet. Falls nicht, muss es noch angelegt werden.
Private Sub StartBtn_Click()
Dim fRng As Range
Dim u() As Variant
Dim w As Worksheet
If Not ValidierungOK Then GoTo errorhandler1
On Error GoTo errorhandler1
Set fRng = Range(Me.fTableCellRefE.Value).CurrentRegion
u = Unfold.unfoldTableG(fRng, CInt(Me.fColNoTBx.Text))
If Not Hlp.wrkshExists(Me.resultWsTBx.Text) Then
Worksheets.Add.Name = Me.resultWsTBx.Text
End If
Set w = Worksheets(Me.resultWsTBx.Text)
w.Cells.Clear
w.Range(w.Cells(1, 1), w.Cells(UBound(u, 1), UBound(u, 2))) = u
MsgBox "successful"
Exit Sub
errorhandler1:
MsgBox "Error: Conversion was not possible"
End Sub
Private Function ValidierungOK() As Boolean
If Not ValHlp.istImGanzzBereich(Me.fColNoTBx.Text, 1, 100) Or _
Not ValHlp.istName(Me.resultWsTBx.Text) Or _
Me.fTableCellRefE.Text = "" Then
MsgBox "check your input"
ValidierungOK = False
Exit Function
End If
ValidierungOK = True
End Function
Der Code des Moduls ValHlp
Von den Funktionen dieses Moduls werden hier nur die gezeigt, welche im Programm gebraucht werden.
'ermittelt für den Wert z, ob er einer Ganzzahl entspricht;
'z kann auch ein String sein
Public Function istGanzzahl(ByVal z As Variant) As Boolean
If Not IsNumeric(z) Then
istGanzzahl = False
Else
If CLng(z) - Int(z) = 0 Then
istGanzzahl = True
Else
istGanzzahl = False
End If
End If
End Function
'ermittelt für den Wert z, ob er einer Ganzzahl entspricht und
'im Bereich [min, max] liegt; z kann auch ein String sein
Public Function istImGanzzBereich(ByVal z As Variant, _
ByVal min As Long, _
ByVal max As Long) As Boolean
If Not istGanzzahl(z) Then
istImGanzzBereich = False
Else
If CLng(z) >= min And CLng(z) <= max Then
istImGanzzBereich = True
Else
istImGanzzBereich = False
End If
End If
End Function
'ermittelt für den Wert s, ob er den Anforderungen für einen
'Namen genügt; Achtung: fängt nicht alle Fehler ab!
Public Function istName(ByVal s As String) As Boolean
istName = True
If Not istBuchstabe(Mid(s, 1, 1)) Then
istName = False
Else
Dim i As Integer
For i = 1 To Len(s)
If Not (istBuchstabe(Mid(s, i, 1)) Or Mid(s, i, 1) = " " _
Or Mid(s, i, 1) = "-" Or Mid(s, i, 1) = "." Or _
Mid(s, i, 1) = "'") Then
istName = False
End If
Next
End If
End Function
'prüft, ob das übergebene Zeichen ein Buchstabe ist; bezieht
'dabei auch Umlaute mit ein
Public Function istBuchstabe(ByVal c As String) As Boolean
c = Mid(c, 1, 1)
If c >= "A" And c <= "Z" Or _
c >= "a" And c <= "z" Or _
c = "Ä" Or c = "ä" Or c = "Ü" Or _
c = "ü" Or c = "Ö" Or c = "ö" Then
istBuchstabe = True
Else
istBuchstabe = False
End If
End Function
Der Code des Moduls Hlp
Dieses Modul enthält hier nur eine einzige Funktion wrkshExists, welche überprüft, ob sich ein Arbeitsblatt bestimmten Namens bereits in der Arbeitsmappe befindet.
Public Function wrkshExists(ByVal wName As String) As Boolean
wrkshExists = False
Dim w As Worksheet
For Each w In Worksheets
If w.Name = wName Then
wrkshExists = True
Exit For
End If
Next w
End Function