Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Namenslisten-Vergleich unter der Berücksichtigung der Abteilung
#1
Hallo zusammen,

ich brauche Eure Hilfe. 
Irgendwie arbeitet mein Code nicht. Confused

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


Angehängte Dateien
.xlsm   Abrechnung der Anwesenheit.xlsm (Größe: 21,6 KB / Downloads: 7)
.xlsx   Anwesenheit.xlsx (Größe: 11,73 KB / Downloads: 6)
Antworten Top
#2
Hallo Tommics,

da Du das Kostenstellen-Array so definiert hast: Kostenstellen = Array("4090", "1090"), mußt Du in der 'IsInArray'-Funktion so vergleichemn: If CInt(element) = CInt(valToBeFound), denn 'element' ist vom Typ 8 (Text) und valToBeFound vom Typ 5 (Gleitkommazahl)
oder Du definierst: Kostenstellen = Array(4090, 1090)

Gruß von Luschi
aus klein-Paris
Antworten Top
#3
Vielen Dank für den Hinweis, aber die Zieldatei überträgt die fehlenden Namen immer noch nicht.
Antworten Top
#4
Hallo Tommics,

Du prüfst ja auch : If Not found Is Nothing Then - also wenn der Name gefunden wurde
die Prüfung muß so erfolgen: If found Is Nothing Then
lt. Range.Find Vba-Hilfe:
Bemerkungen
Diese Methode gibt Nothing zurück , wenn keine Übereinstimmung gefunden wird.
Außerdem steht dort auch:
Die Einstellungen für LookIn , LookAt , SearchOrder und MatchByte werden jedes Mal gespeichert, wenn Sie diese Methode verwenden.
Bei Dir fehlen die Parameter LookIn, SearchOrder und MatchByte und diese Infos holt sich Excel aus dem letzten Oberflächen-Suchbefehl (Strg+F); war das Suchen in Formeln, Du willst aber in Vba nach Werten suchen, geht sowas ganz schnell in die Hose., da LookIn den falschen Parameter an Vba übergibt.

Gruß von Luschi
aus klein-Paris
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste