AW: Formel mit Macro? - Etwas unklar!
11.01.2007 00:12:32
Erich
Hallo Alina,
hier habe ich mal die Spaltennummern angepasst:
Option Explicit
Sub Angehoerige_anlegen()
Dim wsZ As Worksheet, lngQ As Long, lngZ As Long, zQ As Long, zZ As Long
Dim ii As Integer, jj As Integer, intEhe As Integer, intKin As Integer
Set wsZ = Sheets("Angehörige")
lngZ = wsZ.Cells(Rows.Count, 1).End(xlUp).Row
If lngZ < wsZ.Cells(Rows.Count, 4).End(xlUp).Row Then _
lngZ = wsZ.Cells(Rows.Count, 4).End(xlUp).Row
With Sheets("Input")
lngQ = .Cells(Rows.Count, 2).End(xlUp).Row
For zQ = 4 To lngQ
If .Cells(zQ, 7) = "Verheiratet" Or .Cells(zQ, 9) > 0 Then
For zZ = 5 To lngZ
If .Cells(zQ, 2) = wsZ.Cells(zZ, 1) And _
.Cells(zQ, 3) = wsZ.Cells(zZ, 3) And _
.Cells(zQ, 5) = wsZ.Cells(zZ, 7) Then Exit For
Next zZ
If zZ > lngZ Then
lngZ = lngZ + 1
wsZ.Cells(lngZ, 1) = .Cells(zQ, 2)
wsZ.Cells(lngZ, 3) = .Cells(zQ, 3)
wsZ.Cells(lngZ, 7) = .Cells(zQ, 5)
' wsZ.Cells(lngZ, 8) = keine Nationalität in Input
End If
End If
Next zQ
For zQ = 4 To lngQ
For zZ = 5 To lngZ
If .Cells(zQ, 2) = wsZ.Cells(zZ, 1) And _
.Cells(zQ, 3) = wsZ.Cells(zZ, 3) And _
.Cells(zQ, 5) = wsZ.Cells(zZ, 7) Then
ii = 0
intEhe = 0
intKin = 0
While IsEmpty(wsZ.Cells(zZ + ii + 1, 1)) And _
Not IsEmpty(wsZ.Cells(zZ + ii + 1, 4))
ii = ii + 1
If Left(wsZ.Cells(zZ + ii, 6), 3) = "Ehe" Then intEhe = intEhe + 1
If Left(wsZ.Cells(zZ + ii, 6), 4) = "Sohn" Or _
wsZ.Cells(zZ + ii, 6) = "Tochter" Then intKin = intKin + 1
Wend
If .Cells(zQ, 7) <> "Verheiratet" And intEhe > 0 Then
MsgBox wsZ.Cells(zZ, 1) & " (Zeile " & zZ & ") hat Ehe...," _
& " ist aber nicht verheiratet.", vbCritical, "Angehörige"
ElseIf .Cells(zQ, 7) = "Verheiratet" And intEhe = 0 Then
wsZ.Rows(zZ + ii + 1).Insert
zZ = zZ + 1
wsZ.Cells(zZ + ii, 4) = .Cells(zQ, 2)
wsZ.Cells(zZ + ii, 6) = "Ehe"
lngZ = lngZ + 1
End If
If .Cells(zQ, 9) < intKin Then
MsgBox wsZ.Cells(zZ, 1) & " (Zeile " & zZ & ")" & " hat " _
& intKin - .Cells(zQ, 9) & " Kind(er) zuviel.", vbCritical, "Angehörige"
Else
For jj = 1 To .Cells(zQ, 9) - intKin
wsZ.Rows(zZ + ii + jj).Insert
wsZ.Cells(zZ + ii + jj, 4) = .Cells(zQ, 2)
wsZ.Cells(zZ + ii + jj, 6) = "Sohn/Tochter"
Next jj
lngZ = lngZ + .Cells(zQ, 9) - intKin
End If
Exit For
End If
Next zZ
Next zQ
End With
End Sub
Da die Nationalität im Input weggefallen ist, kann sie nicht mehr übertragen werden.
intEhe und intKin sind Namen von Variablen in VBA. Ich verstehe deine Frage nicht.
Was würde sich diesbezüglich in deiner Datei ändern? Vielleicht die Texte "Verheiratet" usw.?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort