Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
188to192
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
188to192
188to192
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hilfe bei VBA

Hilfe bei VBA
10.12.2002 21:24:25
Claudia
Hallo Excel-Freunde!
Ich habe einen Kalender aus dem Internet abgekupfert und unter Mithilfe von einem Excel-"Profi" auch ein tolles Ergebniss erhalten.
Nun habe ich noch ein Problem.
Wie schaffe ich es wenn zwei oder mehr Personen am selben Tag Geburtstag haben beide betreffende Personen aus der Tabell Geburtstage in das Kalenderblatt übertragen werden?????
Geht das denn??? Wie muß ich den VBA-Code ändern damit das funktioniert.
So sieht mein Code aus!!!!!!

Function bewFeiert(Jahr As Integer) As Date
'berechnet das Osterdatum (Sonntag)
Dim D As Integer
D = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21
bewFeiert = DateSerial(Jahr, 3, 1) + D + (D > 48) + 6 - ((Jahr + Jahr \ 4 + D + (D > 48) + 1) Mod 7)

End Function
Sub Termine_eintragen()
'trägt vorgegebene Termine in die Kalenderblätter ein

'Stand: 03.02.2002
Dim termf(100) As Date, feiert(100), termg(100) As Date, namg(100), alte(100), termt(100) As Date, termin(100)
' ***********************************
' Daten einlesen ********************
' ***********************************
Worksheets("Termine").Activate ' Tabellenblatt "Termine" aktivieren
'Feiertage einlesen
z = 3 ' Startzeile für Schleife
Do While Cells(z, 1) <> "" ' Schleifenbedingung (laufe solange Zelle gefüllt ist)
termf(z) = Left(Cells(z, 1), 6) + _
Right(Worksheets("Kalenderblatt").Cells(1, 1), 2) ' Datum (sechs Zeichen von links) + aktuelle Jahreszahl
feiert(z) = Cells(z, 2) ' Namen der Feiertage Auslesen
z = z + 1 ' Schleifenzähler
Loop ' Wendemarke für Schleife
' Geburtstage einlesen
zg = 3
Do While Cells(zg, 3) <> ""
termg(zg) = Cells(zg, 3) ' Einlesen der Geburtstage
namg(zg) = Cells(zg, 4) ' Einlesen der Namen
zg = zg + 1
Loop
' Termine einlesen
zt = 3
Do While Cells(zt, 5) <> ""
If Right(Worksheets("Kalenderblatt").Cells(1, 1), 2) _
<> Right(Cells(zt, 5), 2) Then GoTo sprung1 ' wenn Kalenderjahr des Termins <> Kalenderjahr,
' dann Ausstieg
termt(zt) = Cells(zt, 5) ' Einlesen der Termine (Datum)
termin(zt) = Cells(zt, 6) ' Einlesen der Veranstaltung
sprung1: ' Sprungziel
zt = zt + 1
Loop
' Zielwert für Terminschleife
ziel = z
If ziel < zg Then ziel = zg
If ziel < zt Then ziel = zt
' ***********************************
' Daten in Kalenderblatt übertragen *
' ***********************************
Worksheets("Kalenderblatt").Activate ' Kalenderblatt aktiv schalten
' Alte Einträge löschen
For t = 3 To 33
For m = 1 To 24 Step 2 ' Löschen vorhandener Einträge
Cells(t, m + 1) = "" ' Texte
Cells(t, m).Font.ColorIndex = 0 ' Textfarbe (Datumspalten)
Cells(t, m + 1).Font.ColorIndex = 0 ' Textfarbe (Terminspalten)
Next m
Next t
' Neue Termine eintragen
' Feiertage
For e = 3 To ziel ' Schleife für Termine
For t = 3 To 33 ' Schleife für Tage pro Monat
For m = 1 To 24 Step 2 ' Schleife für Monate
If feiert(e) = "Tag der dt. Einheit" _
And Cells(1, 1) < 1990 Then
termf(e) = "17.06." & Cells(1, 1)
End If
If Cells(t, m) = termf(e) Then ' Wenn Feiertag dann...
Cells(t, m).Font.ColorIndex = 3 ' ...Datum rote Farbe
Cells(t, m + 1).Font.ColorIndex = 3 ' ...Text rote Farbe
Cells(t, m + 1) = feiert(e) ' ...Name des Feiertags aus Tabelle Termine
End If
' Geburtstage eintragen
If Left(Cells(t, m), 6) = Left(termg(e), 6) Then ' Datum im Kalenderblatt mit dem eingelesenen Datum vergleichen
termgr$ = Right(termg(e), 2) + 1900 ' Wenn gleich, dann berechnen des aktuellen Alters
alte(e) = Cells(1, 1) - termgr ' "
If alte(e) < 0 Then GoTo sprung ' Wenn Alter kleiner als 0, Ausstieg
If alte(e) = 0 Then alte(e) = "*" ' Wenn Alter = 0, dann (*)
Cells(t, m + 1).Font.ColorIndex = 5 ' Farbe der Schrift = blau
Cells(t, m + 1) = "Geb. " & namg(e) & " (" & alte(e) & ")" ' Name und Alter eintragen
End If ' Ende des Programmteils
' Sonstige Termine eintragen
If Cells(t, m) = termt(e) Then ' wenn Termin = Datum...
Cells(t, m + 1).Font.ColorIndex = 1 ' ...dann Textfarbe schwarz
Cells(t, m + 1) = termin(e) ' ...Termin eintragen
sprung: ' Sprungziel
End If ' Ende Bedingung
Next m ' Schleifenzähler (For m)
Next t ' Schleifenzähler (For t)
Next e ' Schleifenzähler (For e)
End Sub ' Ende des Makros

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Hilfe bei VBA
11.12.2002 10:29:47
GerdZ
Hallo Claudia,

mit der Zeile
Cells(t, m + 1) = "Geb. " & namg(e) & " (" & alte(e) & ")" ' Name und Alter eintragen
werden die Geburtstage eingetragen.
Dies könnte man z.B. wie folgt ändern:

Gruß
Gerd




Re: Hilfe bei VBA
11.12.2002 12:53:32
Claudia
Hallo Gerd!
Danke für deine schnelle Hilfe. Werde noch heute den neuen VBA-Code einfügen und melde mich wenn alles funktioniert.
Liebe Grüsse aus Kärnten sendet Claudia.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige