Discussion:
Stammbaum, Genealogie, VBA-verschachtelte-Schleife
(zu alt für eine Antwort)
Markus Bärlocher
2005-12-22 00:12:26 UTC
Permalink
Liebe Profis,

meine alte Tante hat 2500 Vorfahren aufgestöbert und diese fein
säuberlich mit Word in den Computer gehackt. Ausgedruckt sieht es
super aus!

Damit das Ganze sortierbar wird und für die spätere Umwandlung in das
Gedcom-Format, habe ich den Text in eine Excel-Tabelle umgewandelt. Nun
ist jede Person mit einer ID-Nr versehen und alles in eindeutige
Spalten sortiert.

Die Tabelle ist folgendermassen sortiert:

0 Grossvater, G1
1 --Vater1, G2
2 ----Sohn1, G3
3 ------Enkel1, G4
4 ------Enkel2, G4
5 ----Sohn2, G3
6 --Vater2, G2
7 ----Sohn1, G3
8 ----Sohn2, G3
9 ------Enkel1, G4

Um für das Genealogie-Programm die Verknüpfung herzustellen, hat jede
Person ein Feld "ist-Kind-von:" Feld-Inhalt soll sein die ID des
Vaters.
Beispiel:
Vater von Person 5 ist Person 1
Vater von Person 9 ist Person 8

Nun bräuchte ich ein Makro, das die ganze Tabelle durchläuft und
prüfe für jede Zeile,
ob die Zeile darüber eine niedrigere Zahl in GENERATION stehen hat
schreibe die Satznummer dieses (darüberstehenden) Satzes (also der Vater) in das Feld IST-KIND-VON
prüfe die nächste Zeile darüber...
Leider habe ich keine Ahnung von VBA-Syntax.
fände super, wenn Du mir so ein Makro (als kleines Weihnachtsgeschenk
für mich - und meine Tante) schreiben könntest...!

Herzlichen Dank,
Markus
Georg Mildenberger
2005-12-21 10:08:46 UTC
Permalink
Hallo Markus,
Post by Markus Bärlocher
Liebe Profis,
meine alte Tante hat 2500 Vorfahren aufgestöbert und diese fein
säuberlich mit Word in den Computer gehackt. Ausgedruckt sieht es
super aus!
Damit das Ganze sortierbar wird und für die spätere Umwandlung in das
Gedcom-Format, habe ich den Text in eine Excel-Tabelle umgewandelt. Nun
ist jede Person mit einer ID-Nr versehen und alles in eindeutige
Spalten sortiert.
0 Grossvater, G1
1 --Vater1, G2
2 ----Sohn1, G3
3 ------Enkel1, G4
4 ------Enkel2, G4
5 ----Sohn2, G3
6 --Vater2, G2
7 ----Sohn1, G3
8 ----Sohn2, G3
9 ------Enkel1, G4
Um für das Genealogie-Programm die Verknüpfung herzustellen, hat jede
Person ein Feld "ist-Kind-von:" Feld-Inhalt soll sein die ID des
Vaters.
Vater von Person 5 ist Person 1
Vater von Person 9 ist Person 8
Nun bräuchte ich ein Makro, das die ganze Tabelle durchläuft und
prüfe für jede Zeile,
ob die Zeile darüber eine niedrigere Zahl in GENERATION stehen hat
schreibe die Satznummer dieses (darüberstehenden) Satzes (also der Vater) in das Feld IST-KIND-VON
prüfe die nächste Zeile darüber...
Leider habe ich keine Ahnung von VBA-Syntax.
fände super, wenn Du mir so ein Makro (als kleines Weihnachtsgeschenk
für mich - und meine Tante) schreiben könntest...!
das ginge, wenn auch nicht so elegant, recht einfach mit ein paar
verschachtelten Wenn-Funktionen. Man wrid zwar eineige Problemfälle von
Hand nacharbeiten müssen, aber das hielte sich dann in Grenzen. Wenn Du
möchtest, dann schicke ich Dir eine Beispieldatei.

Gruß
Schorsch
Peter Lederer
2005-12-22 13:00:13 UTC
Permalink
Post by Markus Bärlocher
Vater von Person 5 ist Person 1
Vater von Person 9 ist Person 8
Nun bräuchte ich ein Makro, das die ganze Tabelle durchläuft und
prüfe für jede Zeile,
ob die Zeile darüber eine niedrigere Zahl in GENERATION stehen hat
schreibe die Satznummer dieses (darüberstehenden) Satzes (also der Vater) in das Feld IST-KIND-VON
prüfe die nächste Zeile darüber...
Die Anweisung für das Makro widerspricht sich m.E. mit dem genannten
Beispiel. Wenn ich in Zeile 5 prüfe, ob in Zeile 4 ("prüfe die Zeile
darüber...") eine niedrigere Zahl steht, erhalte ich nicht das von Dir
gewünschte Ergebenis (Person 1).

Verstehe ich es richtig, dass das Ergebnis in etwa so aussehen soll?

0 Grossvater, G1
1 --Vater1, G2 Ist Kind von 0
2 ----Sohn1, G3 Ist Kind von 1
3 ------Enkel1, G4 Ist Kind von 2
4 ------Enkel2, G4 Ist Kind von 2
5 ----Sohn2, G3 Ist Kind von 1
6 --Vater2, G2 Ist Kind von 0
7 ----Sohn1, G3 Ist Kind von 6
8 ----Sohn2, G3 Ist Kind von 6
9 ------Enkel1, G4 Ist Kind von 8

Kommt G1 in der gesamten Liste nur einmal vor?
Bis zu welcher Nummer kann G gehen (G1 - G?)

Mit folgendem Code (ich weiß, man kann es schöner machen), kommt o.a.
Ergebnis raus. Vorrausgesetzt, es gibt nicht mehr als 9999 Einträge und es
gibt nur G1 - G4.

Sub kind_von()

Dim PERS1, PERS2, COUNT, GROSSVATER, VATER
COUNT = 1

Do
If COUNT < 10 Then
strleft = 1
ElseIf COUNT >= 10 And COUNT < 99 Then
strleft = 2
ElseIf COUNT >= 100 And COUNT < 999 Then
strleft = 3
ElseIf COUNT >= 1000 And COUNT < 9999 Then
strleft = 4
End If

If CInt(Right(Cells(COUNT, 1).Value, 1)) = 1 Then
GROSSVATER = CInt(Left(Cells(COUNT, 1).Value, strleft))
End If

If CInt(Right(Cells(COUNT, 1).Value, 1)) = 2 Then
VATER = CInt(Left(Cells(COUNT, 1).Value, strleft))
End If

PERS1 = CInt(Right(Cells(COUNT, 1).Value, 1))
PERS2 = Right(Cells(COUNT + 1, 1).Value, 1)
If PERS2 = "" Then Exit Sub
PERS2 = CInt(Right(Cells(COUNT + 1, 1).Value, 1))

If PERS2 > PERS1 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & Left(Cells(COUNT,
1).Value, strleft)
End If
If PERS2 = PERS1 Then
Cells(COUNT + 1, 2).Value = Cells(COUNT, 2).Value
End If
If PERS2 < PERS1 Then
If PERS2 = 4 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & VATER
ElseIf PERS2 = 3 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & VATER
ElseIf PERS2 = 2 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & GROSSVATER
End If
End If
COUNT = COUNT + 1
Loop

End Sub
--
Grüße
Peter
WIN XP Prof. SP2, Excel 2002
Markus Bärlocher
2005-12-22 16:07:29 UTC
Permalink
Lieber Peter,

Du hast meine Beschreibung richtig verstanden.

Die Spalten/Felder sind:
ID, Name, Generation, Kind-von
(num, char, num, num)

- das "G" war nur zur Erläuterung.
- die "---" vor dem Namen sind nur hier in der Mailingliste zu
"optischen" Darstellung der Hierarchie (tut mir leid, dass das jetzt
irrtümlich so ausgesehen hat, als wäre das Teil des Feldinhaltes -
ursprünglich war es das sogar, da die Tante in der Worddatei für jede
Generation einen Tab gesetzt hatte - daraus habe ich die
GenerationsEbene errechnet und dann die Tabs vor der Umwandlung nach
Excel rausgemacht)
0, Grossvater, 1,
1, --Vater1, 2, Ist Kind von 0
2, ----Sohn1, 3, Ist Kind von 1
3, ------Enkel1, 4, Ist Kind von 2
4, ------Enkel2, 4, Ist Kind von 2
5, ----Sohn2, 3, Ist Kind von 1
6, --Vater2, 2, Ist Kind von 0
7, ----Sohn1, 3, Ist Kind von 6
8, ----Sohn2, 3, Ist Kind von 6
9, ------Enkel1, 4, Ist Kind von 8
Gerneration hat den Wert 1...10 (bis jetzt...)
Dein Ergebnis ist richtig. ("ist Kind von" ist Feldname, "8" ist
num.Feldinhalt)

Den Code habe ich nicht verstanden...
Mit folgendem Code kommt o.a. Ergebnis raus.
Vorrausgesetzt, es gibt nicht mehr als 9999 Einträge und es
gibt nur G1 - G4.
Sub kind_von()
Dim PERS1, PERS2, COUNT, GROSSVATER, VATER
COUNT = 1
Do
If COUNT < 10 Then
strleft = 1
ElseIf COUNT >= 10 And COUNT < 99 Then
strleft = 2
ElseIf COUNT >= 100 And COUNT < 999 Then
strleft = 3
ElseIf COUNT >= 1000 And COUNT < 9999 Then
strleft = 4
End If
If CInt(Right(Cells(COUNT, 1).Value, 1)) = 1 Then
GROSSVATER = CInt(Left(Cells(COUNT, 1).Value, strleft))
End If
If CInt(Right(Cells(COUNT, 1).Value, 1)) = 2 Then
VATER = CInt(Left(Cells(COUNT, 1).Value, strleft))
End If
PERS1 = CInt(Right(Cells(COUNT, 1).Value, 1))
PERS2 = Right(Cells(COUNT + 1, 1).Value, 1)
If PERS2 = "" Then Exit Sub
PERS2 = CInt(Right(Cells(COUNT + 1, 1).Value, 1))
If PERS2 > PERS1 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & Left(Cells(COUNT,
1).Value, strleft)
End If
If PERS2 = PERS1 Then
Cells(COUNT + 1, 2).Value = Cells(COUNT, 2).Value
End If
If PERS2 < PERS1 Then
If PERS2 = 4 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & VATER
ElseIf PERS2 = 3 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & VATER
ElseIf PERS2 = 2 Then
Cells(COUNT + 1, 2).Value = "Ist Kind von " & GROSSVATER
End If
End If
COUNT = COUNT + 1
Loop
End Sub
Mit herzlichem Dank für Deine Unterstützung!
Markus
Peter Lederer
2005-12-22 16:56:42 UTC
Permalink
Post by Markus Bärlocher
Mit herzlichem Dank für Deine Unterstützung!
Ist denn Dein Problem gelöst? Wenn nicht und Du weiter an einer VBA-Lösung
(ich bin wahrlich kein Profi, "bastele" aber gerne) interessiert bist, wäre
es hilfreich, wenn Du mir die Datei mailen köntest, damit ich mal sehe,
welche Varianten auftauchen und wie sie genau aufgebaut ist.

Ich bin allerdings von morgen an im Urlaub und komme erst am 26.12. wieder.
Da sich dann die Programmierung auf den Abend beschränkt, kann es u. U.
noch ein paar Tage dauern.
--
Grüße
Peter
WIN XP Prof. SP2, Excel 2002
Walter Griesser
2005-12-22 23:56:31 UTC
Permalink
Hallo Markus
Liebe Profis,meine alte Tante hat 2500 Vorfahren aufgestöbert und diese
fein
säuberlich mit Word in den Computer gehackt. Ausgedruckt sieht es
super aus! Damit das Ganze sortierbar wird und für die spätere Umwandlung
in das
Gedcom-Format, habe ich den Text in eine Excel-Tabelle umgewandelt. Nun
ist jede Person mit einer ID-Nr versehen und alles in eindeutige
0 Grossvater, G1
1 --Vater1, G2
2 ----Sohn1, G3
3 ------Enkel1, G4
4 ------Enkel2, G4
5 ----Sohn2, G3
6 --Vater2, G2
7 ----Sohn1, G3
8 ----Sohn2, G3
9 ------Enkel1, G4
Um für das Genealogie-Programm die Verknüpfung herzustellen, hat jede
Person ein Feld "ist-Kind-von:" Feld-Inhalt soll sein die ID des
Vaters.Beispiel: Vater von Person 5 ist Person 1 Vater von Person 9 ist
Person 8
Nun bräuchte ich ein Makro, das die ganze Tabelle durchläuft und
prüfe für jede Zeile,
ob die Zeile darüber eine niedrigere Zahl in GENERATION stehen hat
schreibe die Satznummer dieses (darüberstehenden) Satzes (also der Vater)
in das Feld IST-KIND-VON
prüfe die nächste Zeile darüber...
So muß es im Excel ausschauen, damit folgnder Code dann funkt (mit
Überschriften):
ansonsten anpassen.

ID Name Generation Kind-von

0 Grossvater 1

1 Vater1 2

2 Sohn1 3

3 Enkel1 4

4 Enkel2 4

5 Sohn2 3

6 Vater2 2

7 Sohn1 3

8 Sohn2 3

9 Enkel1 4

10 Enkel2 5



Code:



Sub Kindvon()
Dim Au As Object
Dim Bu As Object
Set Au = Cells(1, 1).CurrentRegion
Zi = Au.Rows.Count
Set Bu = Range(Cells(3, 3), Cells(Zi, 3))
For Each i In Bu
i.Select
i = -1
Do
If ActiveCell.Offset(i, 0) < ActiveCell Then
ActiveCell.Offset(0, 1) = ActiveCell.Offset(i, -2)
Exit Do
End If
i = i - 1
Loop
Next i
End Sub


Bin ab morgen Freitag, 12 Uhr nicht mehr online



Gruß

Walter

Loading...