Thema Datum  Von Nutzer Rating
Antwort
Rot Daten strukturieren
 30.07.2012 10:52:08 Rada
***
NotSolved

Ansicht des Beitrags:
Von:
Rada		 Datum:
30.07.2012 10:52:08		 Views:
2003		 Rating:
     
Antwort:
  Ja
Thema:
Daten strukturieren

Hallo zusammen!

Ich bräuchte Hilfe bei einem Makro, welches mir riesen Datenmengen strukturiert. Dabei handelt es sich um Umzugsdaten, wobei je nach Bundesland die jeweiligen Kreise in alle Kreise Deutschlands nach Altersgruppen sortiert sind. Je nachdem eben, ob jmd. von diesem Kreis in den anderen gezogen ist. Entsprechend ist die Struktur nicht vollständig. Ich brauche aber eine komplette Struktur von jedem Kreis in jeden Kreis je Altersgruppe. Dafür dann das Makro. Ich habe bereits eines, das an sich auch funktioniert und mir meine Tabellen sortiert (mittels einlesen der jeweiligen Kreisdaten (ist ja je Bundesland anders, deswegen auch dynamisch festgelegt) und 3er-Schleife; dann werden in einer Spalte diese Zeilen nummeriert, fehlt ein Kreis oder eine Altersgruppe wird schlichtweg eine Leerzeile mit der entsprechenden fortlaufenden Nummer unten angefügt, später sortier ich sie nach der Spalte und hab meine Struktur), ABER - jetzt das Problem - hin und wieder kommt es vor, dass er mir zwar die Alterklasse richtig sortiert aber in den vorherigen Zielkreis hinein. Der eigentliche Zielkreis ist mit 6 Leerzeilen vorhanden, nur steht dann eben die schon vorhandene Zeile im falschen Kreis.

So sieht es richtig aus:

      3491 1
10041 13006 18 - 25 3492 2
10041 13006 25 - 30 3493 3
      3494 4
      3495 5
10041 13006 65 und älter 3496 6

 und so sieht es eben falsch aus:

      3501 1
10041 13051 18 - 25 3502 2
      3503 3
10041 13052 30 - 50 3504 4
10041 13053 50 - 65 3505 5
      3506 6
      3511 1
      3512 2
      3513 3
      3514 4
      3515 5
      3516 6
      3521 1
      3522 2
      3523 3
      3524 4
      3525 5
      3526 6

Und da ich das nicht "per Hand" überprüfen und korrigieren kann, da es sich um 70 Tabellen handelt mit im Schnitt je 40.000 Zeilen, wäre es toll, wenn mir da jemand beim Makro helfen könnte.

Hier das Makro:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
Option Explicit
Option Base 1 'Datenfelder werden ab 1 gezählt
 
Public Const anzAltersgruppen = 6
'Public Const anzZielKreise = 413
'Public Const anzHerkKreise = 44
 
Sub WanderungsDatenStrukturieren()
 
'Die Prozedur strukturiert unvollständige Datensätze
'enstprechend Randinformationen um.
 
Dim StrSteuersheet As String
Dim StrKreissheet As String
Dim IntHerkunfskreisSpalte As Integer
Dim IntZielkreisSpalte As Integer
Dim IntAltersgruppeSpalte As Integer
Dim IntSortierKriteriumAltersgruppe As Integer
Dim IntErsteZeiteDatensheet As Integer
Dim intEndzeileDatensheet As Integer
Dim StrAltersgruppen() As String
Dim IntAltersgruppen() As Integer
Dim LngAltersgruppenFehlend() As Long
Dim StrKreisSchluesselZiel() As String
Dim StrKreisSchluesselHerk() As String
Dim IntAnzHerkunftskreiseLeer As Integer
 
Dim anzZielKreise As Integer
Dim anzHerkKreise As Integer
 
Dim IntAltersgruppeErg As Integer
Dim LngAltersgruppenEintrag As Long
 
Dim i As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim izeile As Long
Dim ifehl As Integer
Dim idurchlauf As Integer
Dim iadd As Integer
Dim iendzeile As Long
Dim ialter As Long
Dim ikreisZiel As Integer
Dim ikreisHerk As Integer
 
'Rahmenwerte setzen
StrSteuersheet = "Steuer"
Sheets(StrSteuersheet).Select
StrKreissheet = Range("C11")
anzHerkKreise = Range("C13")
anzZielKreise = Range("C14")
IntErsteZeiteDatensheet = Range("C15")
intEndzeileDatensheet = Range("C16")
IntHerkunfskreisSpalte = Range("C17")
IntZielkreisSpalte = Range("C18")
IntAltersgruppeSpalte = Range("C19")
IntSortierKriteriumAltersgruppe = Range("C20")
LngAltersgruppenEintrag = 0
iadd = 10
ialter = IntErsteZeiteDatensheet
 
ReDim StrAltersgruppen(anzAltersgruppen) As String
ReDim IntAltersgruppen(anzAltersgruppen) As Integer
ReDim LngAltersgruppenFehlend(anzAltersgruppen) As Long
ReDim StrKreisSchluesselZiel(anzZielKreise) As String
ReDim StrKreisSchluesselHerk(anzHerkKreise) As String
 
 
'Einlesen Altersgruppen
Sheets(StrSteuersheet).Select
Range("C3").Select
For i = 1 To anzAltersgruppen
    StrAltersgruppen(i) = Cells(i + 2, 3)
    IntAltersgruppen(i) = i
Next
 
'Einlesen Kreisschluessel Herkunftskreis
Sheets(StrSteuersheet).Select
Range("F3").Select
For i = 1 To anzHerkKreise
    StrKreisSchluesselHerk(i) = Cells(i + 2, 6)
    Debug.Print StrKreisSchluesselHerk(i)
Next
 
'Einlesen Kreisschluessel Zielkreis
Sheets(StrSteuersheet).Select
Range("G3").Select
For i = 1 To anzZielKreise
    StrKreisSchluesselZiel(i) = Cells(i + 2, 7)
Next
 
Sheets(StrKreissheet).Select
Cells(IntErsteZeiteDatensheet, IntSortierKriteriumAltersgruppe).Select
iendzeile = intEndzeileDatensheet 'Läufer für die Endzeile wird initialisiert
izeile = IntErsteZeiteDatensheet
'*** Alle Herkunftskreis, alleZielkreis, unterschiedliche Altersgruppen *****
For ikreisHerk = 1 To anzHerkKreise
  '*** Ein Herkunftskreis, alleZielkreis, unterschiedliche Altersgruppen *****
  If Cells(izeile, IntHerkunfskreisSpalte) = StrKreisSchluesselHerk(ikreisHerk) Then
    'Es geht weiter
    ikreisZiel = 1
    'izeile = IntErsteZeiteDatensheet
    'Cells(IntErsteZeiteDatensheet, IntSortierKriteriumAltersgruppe).Select
    For ikreisZiel = 1 To anzZielKreise
        'Kreis idendifizieren -> Prüfung, ob vorhanden, sondern durch Leerzeilen ersetzen StrKreisSchluesselZiel
        'Ist der Kreisschlüssel für diese Zeile tatsächlich der richtige Schlüssel aus der Reihenfolge der Kreisschlüssel?
        If Cells(izeile, IntZielkreisSpalte) = StrKreisSchluesselZiel(ikreisZiel) Then
            'Altersgruppenarbeit kann beginnen
            'Pro Kreis
            '*** Ein Herkunftskreis, ein Zielkreis, unterschiedliche Altersgruppen *****
            'pro idealer Altersgruppe, es werden die Indices 1 - 6 durchlaufen
            'izeile = IntErsteZeiteDatensheet
            For i = 1 To anzAltersgruppen
                LngAltersgruppenFehlend(i) = 0
            Next
            ifehl = 1
            idurchlauf = 1
            For i = 1 To 6
                'Altersgruppe für aktuelle Zelle ermitteln
                'Letzte Zeile erreicht, Prozedur wird verlassen
                If IsNull(CStr(Cells(izeile, IntAltersgruppeSpalte))) Then Exit Sub
                IntAltersgruppeErg = Altersgruppe2Zahl(CStr(Cells(izeile, IntAltersgruppeSpalte)))
                If IntAltersgruppeErg < idurchlauf Then
                   'nächsten Gruppe ist dran, es fehlen aber noch Werte
                   'Restliche Werte in den das Fehlend - Datenfeld
                   For i2 = i To anzAltersgruppen
                       LngAltersgruppenFehlend(ifehl) = i2 + LngAltersgruppenEintrag
                       ifehl = ifehl + 1
                   Next
                   Exit For
                End If
                'Falls Fehlerwert in der Altersgruppe, d.h. irgendein unbekanntes Zeichen bei den Altersgruppen
                'wird die Prozedur verlassen
                If IntAltersgruppeErg = 99 Then Exit Sub
         
                'vorhandene Altersgruppen werden eingetragen, nicht vorhandene gemerkt
                If IntAltersgruppeErg = i Then
                   'Altersgruppe vorhanden
                   Cells(izeile, IntSortierKriteriumAltersgruppe) = IntAltersgruppeErg + LngAltersgruppenEintrag
                   izeile = izeile + 1
                Else
                   'Altersgruppe nicht vorhanden
                   LngAltersgruppenFehlend(ifehl) = i + LngAltersgruppenEintrag
                   ifehl = ifehl + 1
                End If
                idurchlauf = idurchlauf + 1
                'Cells (IntErsteZeiteDatensheet + i)
            Next
 
            'restliche Altersgruppen ausgeben
            For i = 1 To ifehl - 1
                Cells(iendzeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenFehlend(i)
                iendzeile = iendzeile + 1
            Next
            LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
        Else
             'Dieser Kreis existiert nicht
             'Leerzeilen einfügen
             'MsgBox "Den Zielkreis mit dem Kreisindex " & ikreisZiel & " gibt es nicht! Für Kreis xy werden sechs Zeilen eingefügt."
             Rows(izeile & ":" & izeile + 5).Select
             Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
             Cells(izeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 1
             Cells(izeile + 1, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 2
             Cells(izeile + 2, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 3
             Cells(izeile + 3, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 4
             Cells(izeile + 4, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 5
             Cells(izeile + 5, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 6
             izeile = izeile + 6
             LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
             iendzeile = iendzeile + anzAltersgruppen
        End If
    Next 'Ende Ebene Zielkreis
  Else
    'Herkunftskreis ist nicht vorhanden
    'Leerzeilen einfügen
    IntAnzHerkunftskreiseLeer = anzAltersgruppen * anzZielKreise
    MsgBox "Den Herkunftskreis mit dem Kreisindex " & ikreisZiel & " gibt es nicht! Für Kreis xy werden sechs * " & anzZielKreise & " eingefügt. Dies sind " & IntAnzHerkunftskreiseLeer & " Zeilen."
    Rows(izeile & ":" & izeile + IntAnzHerkunftskreiseLeer - 1).Select
    Debug.Print
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Debug.Print
    For i2 = 1 To IntAnzHerkunftskreiseLeer
        For i3 = 1 To anzAltersgruppen
            Cells(izeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + i3
            izeile = izeile + 1
        Next
        LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
        i2 = i2 + anzAltersgruppen
    Next
    iendzeile = iendzeile + IntAnzHerkunftskreiseLeer
  End If
 
Next 'Ende Ebene Herkunftkreise
 
End Sub
Public Function Altersgruppe2Zahl(StrAltersgruppe As String) As Integer
 
'Wandelt eine gegebene Altergruppen in die zugehörige Ordnungszahlzahl um
 
Select Case StrAltersgruppe
Case "unter 18"
    Altersgruppe2Zahl = 1
Case "18 - 25"
    Altersgruppe2Zahl = 2
Case "25 - 30"
    Altersgruppe2Zahl = 3
Case "30 - 50"
    Altersgruppe2Zahl = 4
Case "50 - 65"
    Altersgruppe2Zahl = 5
Case "65 und älter"
    Altersgruppe2Zahl = 6
Case Else
    MsgBox "Altersgruppe nicht definiert, Prozedur wird abgebrochen"
    Altersgruppe2Zahl = 99
End Select
 
End Function

Wäre sehr toll, wenn mir jemand helfen könnte! :-)

Viele Grüße und schon mal lieben Dank! Rada

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Daten strukturieren
 30.07.2012 10:52:08 Rada
***
NotSolved