Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro

Forumthread: Makro

Makro
08.02.2009 21:48:00
Ralf
Hallo Forum
Habe mir ein Makro gebastelt , was ich im Forum bzw Beispielen gefunden habe.
Ich habe in der Tabelle21 ,Spalte 7 Geburtsdaten stehen .Und nun möchte ich
die Daten zu meiner Tabelle 20 zuordnen lassen . Es übernimmt Namen und Alter.
Das klappt auch wunderbar wenn ich nur zwei Geburtsdaten zu einen Tag habe.
Sobald ein drittes hinzukommt schreibt er mir in Spalte C und D die letzten gefundenen
Daten . Hat einer eine Lösung ? Hier mein Makro .

Sub Termine_eintragen()
Dim termg(100) As Date
Dim namg(100) As String
On Error Resume Next
Worksheets("Tabelle20").Activate
zg = 2
Do While Cells(zg, 7)  ""
termg(zg) = Cells(zg, 7)
namg(zg) = Cells(zg, 3) & " " & Cells(zg, 2) & " hat Geb. und wird " & Cells(zg, 11)
zg = zg + 1
Loop
Worksheets("Tabelle21").Activate
Range("B3:B33,C3:C33,D3:D33").ClearContents
Range("A3:A33").Font.ColorIndex = 1
For e = 2 To zg
For T = 3 To 33
m = 1
If Left(Cells(T, m), 6) = Left(termg(e), 6) Then
Cells(T, m + 1).Font.ColorIndex = 5
Cells(T, m + 2).Font.ColorIndex = 5
If Len(Cells(T, m + 1)) > 1 Then
Cells(T, m + 1) = Cells(T, m + 1)
Cells(T, m + 2) = namg(e)
Cells(T, m + 3) = namg(e)
Else: Cells(T, m + 1) = namg(e)
If Len(Cells(T, m + 1)) > 25 Then _
Cells(T, m + 1).Font.Size = 10
Cells(T, m + 2).Font.Size = 10
End If
End If
Next T
Next e
End Sub


Gruss
Ralf

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro
08.02.2009 22:41:00
chris
Kannst du mal eine Beispielmappe anhängen ?
AW: Makro (fertig)
08.02.2009 23:25:08
chris
Hallo Ralf,
habe es doch einmal nach gebaut.
So klappt es wenn ich Dich richtig verstanden habe:

Sub Termine_eintragen()
Dim termg(100) As Date
Dim namg(100) As String
On Error Resume Next
Worksheets("Tabelle20").Activate
zg = 2
Do While Cells(zg, 7)  ""
termg(zg) = Cells(zg, 7)
namg(zg) = Cells(zg, 3) & " " & Cells(zg, 2) & " hat Geb. und wird " & Cells(zg, 11)
zg = zg + 1
Loop
Worksheets("Tabelle21").Activate
Range("B3:B33,C3:C33,D3:D33").ClearContents
Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).Font.ColorIndex = 1
For T = 3 To Cells(Rows.Count, 1).End(xlUp).Row
m = 1
For e = 2 To zg
If Left(Cells(T, 1), 10) = Left(termg(e), 10) Then
Cells(T, m + 1).Font.ColorIndex = 5
If Len(Cells(T, m + 1)) > 1 Then
Cells(T, m + 1) = Cells(T, m + 1)
Cells(T, m + 2) = namg(e)
Cells(T, m + 3) = namg(e)
Else: Cells(T, m + 1) = namg(e)
m = m + 1
If Len(Cells(T, m + 1)) > 25 Then _
Cells(T, m + 1).Font.Size = 10
Cells(T, m + 2).Font.Size = 10
End If
End If
Next e
Next T
End Sub


gruß Chris
P.s Rückmeldung wäre nett

Anzeige
AW: Makro (fertig)
09.02.2009 18:32:13
Ralf
Hallo Chris , Hallo Forum
Klappt wunderbar . Tausend Dank ! Wie ich sehe hast du ein paar Sachen
geändert , das Makro läuft jetzt so wie ich es mir vorstelle . Nochmals
Danke . Was war es denn jetzt ,das du T in einer Schleife gesetzt hast und
hinter Else: m=m+1 ?
Gruss
Ralf
Anzeige
AW: Makro (fertig)
10.02.2009 20:21:23
Ralf
Hallo forum , Hallo Chris
Nochmal Danke
gruss Ralf
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige