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