Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1048to1052
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
Inhaltsverzeichnis

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

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
AW: Makro (fertig)
10.02.2009 20:21:23
Ralf
Hallo forum , Hallo Chris
Nochmal Danke
gruss Ralf

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige