Hallo,
ich habe folgende Aufgabe zu lösen. In einem Tabellenblatt (Blatt1) stehen MA Daten. In 3 anderen stehen die Mitarbeiternr.(TN-Listen) zugeordnet nach teilgenommene Seminaren.
Jetzt soll zu Blatt1 die Zuordnung aus den 3 anderen geschehen. Dabei sind nicht alle Mitarbeiterdaten -in den anderen Blättern zugeordnet
Herkömmliche Codes (vgl. von 2 Spalten und in ein anderes Blatt oder Spalte schreiben geben nur die Zahlen aus.
z.Bsp.----------------------------------------
Option Explicit
Sub Daten_vergleichen()
Dim Suchname As String, Fundname As Range, letzte_Zeile_Tab1 As Long, _
letzte_Zeile_Tab2 As Long, Wiederholungen As Long, Addresse As String, _
gefundene_Zeile As Long
Application.ScreenUpdating = False
letzte_Zeile_Tab1 = Sheets("Sheet1").Range("A65536").End(xlUp).Row
letzte_Zeile_Tab2 = Sheets("Tabelle1").Range("A65536").End(xlUp).Row
For Wiederholungen = 2 To letzte_Zeile_Tab1
Suchname = Sheets("Sheet1").Cells(Wiederholungen, 1)
With Sheets("Tabelle1").Range("A2:A" & letzte_Zeile_Tab2)
Set Fundname = .Find(What:=Suchname, LookIn:=xlValues)
If Not Fundname Is Nothing Then
Addresse = Fundname.Address
gefundene_Zeile = Fundname.Row
Sheets("Sheet1").Cells(Wiederholungen, 1).Interior.ColorIndex = 4
Sheets("Tabelle1").Cells(gefundene_Zeile, 1).Interior.ColorIndex = 4
Sheets("Tabelle1").Cells(gefundene_Zeile, 1).Copy
Sheets("Auswertung").Cells(Sheets("Auswertung").Range("A65536").End(xlUp). _
Offset(1, 0).Row, 1).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Do
Set Fundname = .FindNext(Fundname)
Loop While Not Fundname Is Nothing And Fundname.Address <> Addresse
End If
End With
Next
End Sub
---------------------------------
Wer kann helfen?
Hänge die Datei mit an.
https://www.herber.de/bbs/user/41046.xls
Danke
Beste Grüsse
Rainer