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

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 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 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

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