Hallo zusammen,
ich brauche Eure Hilfe.
Irgendwie arbeitet mein Code nicht.
Das Makro soll im Arbeitsblatt “Stunden“ arbeiten. Es soll die Namen aus der Zieldatei in der Spalte „A7: A“ mit der Quelldatei in der Spalte „C37:C605“ vergleichen. Bei einer Abweichung der Namen soll das Makro die Kostenstelle der Abweichung in der Quelldatei in der Spalte „H37:H605“ mit den folgenden Kostenstellen „4090“,“1090“ vergleichen. Bei einer Übereinstimmung darf der abweichende Name in das Zielarbeitsblatt unter der betreffenden Kostenstelle mit den folgenden Informationen "Name, Vorname, Personalnummer, Kostenstelle" eingefügt werden. Bei der Übertragung der Kostenstelle in das Zielarbeitsblatt soll die Kostenstelle zwei Mal geschrieben werden. Beispiel, der erste Eintrag ist in „E13“, der zweite Eintrag der Kostenstelle soll darunter eingefügt werden, also in „E14“.
Bedanke mich im Voraus für die Unterstützung.
Ich habe es mit dem unteren Code versucht
ich brauche Eure Hilfe.
Irgendwie arbeitet mein Code nicht.
Das Makro soll im Arbeitsblatt “Stunden“ arbeiten. Es soll die Namen aus der Zieldatei in der Spalte „A7: A“ mit der Quelldatei in der Spalte „C37:C605“ vergleichen. Bei einer Abweichung der Namen soll das Makro die Kostenstelle der Abweichung in der Quelldatei in der Spalte „H37:H605“ mit den folgenden Kostenstellen „4090“,“1090“ vergleichen. Bei einer Übereinstimmung darf der abweichende Name in das Zielarbeitsblatt unter der betreffenden Kostenstelle mit den folgenden Informationen "Name, Vorname, Personalnummer, Kostenstelle" eingefügt werden. Bei der Übertragung der Kostenstelle in das Zielarbeitsblatt soll die Kostenstelle zwei Mal geschrieben werden. Beispiel, der erste Eintrag ist in „E13“, der zweite Eintrag der Kostenstelle soll darunter eingefügt werden, also in „E14“.
Bedanke mich im Voraus für die Unterstützung.
Ich habe es mit dem unteren Code versucht
Code:
Sub Namenvergleich()
Dim wbQuelle As Workbook
Dim wbZiel As Workbook
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim rngQuelle As Range
Dim rngZiel As Range
Dim cell As Range
Dim found As Range
Dim Kostenstellen As Variant
Dim msg As String
' Quelldatei und -arbeitsblatt öffnen
Set wbQuelle = Workbooks.Open(*********Pfad***********)
Set wsQuelle = wbQuelle.Worksheets("Bereich A")
' Zieldatei und -arbeitsblatt öffnen
Set wbZiel = ThisWorkbook
Set wsZiel = wbZiel.Worksheets("Stunden")
' Kostenstellen definieren
Kostenstellen = Array("4090", "1090")
' Durchlaufen Sie jede Zelle in der Zielarbeitsmappe
For Each cell In wsZiel.Range("A7:A" & wsZiel.Cells(wsZiel.Rows.Count, "A").End(xlUp).Row)
' Suchen Sie nach dem Namen in der Quelldatei
Set found = wsQuelle.Range("C37:C605").Find(cell.Value, LookAt:=xlWhole)
' Wenn der Name gefunden wurde und die Kostenstelle übereinstimmt
If Not found Is Nothing Then
If IsInArray(wsQuelle.Cells(found.Row, "H").Value, Kostenstellen) Then
' Fügen Sie die Details in die Zieldatei ein
wsZiel.Cells(cell.Row, "B").Value = wsQuelle.Cells(found.Row, "D").Value
wsZiel.Cells(cell.Row, "C").Value = wsQuelle.Cells(found.Row, "E").Value
wsZiel.Cells(cell.Row, "E").Value = wsQuelle.Cells(found.Row, "H").Value
wsZiel.Cells(cell.Row + 1, "E").Value = wsQuelle.Cells(found.Row, "H").Value
End If
Else
' Wenn der Name nicht gefunden wurde, fügen Sie ihn zur Nachricht hinzu
msg = msg & "Name: " & cell.Value & ", Vorname: " & wsZiel.Cells(cell.Row, "B").Value & ", Kostenstelle: " & wsZiel.Cells(cell.Row, "E").Value & vbNewLine
End If
Next cell
' Wenn es Abweichungen gibt, zeigen Sie eine MsgBox an
If msg <> "" Then
If MsgBox("Es gibt Abweichungen:" & vbNewLine & msg & vbNewLine & "Möchten Sie diese übernehmen?", vbYesNo) = vbYes Then
' Übernehmen Sie die Änderungen
wbZiel.Save
End If
End If
' Schließen Sie die Arbeitsmappen
wbQuelle.Close SaveChanges:=False
End Sub
' Hilfsfunktion zum Überprüfen, ob ein Wert in einem Array vorhanden ist
Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error GoTo IsInArrayError: ' Wenn ein Fehler auftritt, dann ist der Wert nicht im Array
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
IsInArrayExit:
Exit Function
IsInArrayError:
IsInArray = False
Resume IsInArrayExit
End Function