Microsoft Excel

Herbers Excel/VBA-Archiv

Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen

Betrifft: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 22.03.2016 16:44:17

Hi Leute

Ich versuche gerade zwei Arbeitsmappen mittels VBA abzugleichen. In der ersten Mappe lasse ich per Makro dutzende Excel Dateien auswerten für ein Jahresergebnis und in der zweiten Mappe sollen diese Ergebnisse dann mit den Ergebnissen von den letzten Jahren verglichen werden. Das ganze sieht so aus, dass ich in Spalte A einen Mitgliedscode habe anhand dessen ich die zwei Mappen vergleichen möchte. Es kann nämlich sein, dass in Mappe 2 ein Mitglied nicht vorhanden ist und somit dort erst angelegt werden muss.
Wenn also Spalte A von Mappe 2 die gleiche Nummer enthaltet wie Spalte A von Mappe 1, dann sollen Werte aus den Spalten B und C aus Mappe 1 in die Spalten B und F von Mappe 2 eingetragen werden Wenn die Nummer aus Spalte A ungleich ist, dann soll in Mappe 2 eine weitere Zeile eingefügt werden und die Nummer in Spalte A und dann wieder B und C aus Mappe 1 in B und F in Mappe 2 eingetragen werden.

bisher hab ich das versucht so zu lösen, was leider nicht funktionierte:


Sub copy()

Dim i As Integer
i = 1
Workbooks.Open Filename:="C:\Users\Verein\Desktop\test2.xlsm", ReadOnly:=True
Do While ThisWorkbook.Sheets("Tabelle1").Cells(i, 1).Value <> ""
    If ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Tabelle1").Cells(i,  _
 _
 _
 _
 _
1) Then
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
 _
 _
 _
 _
 2)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
 _
 _
 _
 _
 3)
    Else
        Worksheets("Tabelle1").Rows.Insert
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
 _
 _
 _
 _
 1)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
 _
 _
 _
 _
 2)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
 _
 _
 _
 _
 3)
    End If
    
i = i + 1
Loop
    
End Sub

Vielen Dank für jede Hilfe.

  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Fennek
Geschrieben am: 22.03.2016 17:04:50

Hallo,

wie wäre es beide Datei zu öffnen und mit dem sverweis zu vergleichen?


Mfg


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 08:46:54

Ja das hört sich schlüssig an aber dann bleibt immer noch das Problem, dass ich nur vorhandene Mitarbeiternummern vergleichen kann und wenn ein neuer Mitarbeiter dazugekommen ist, muss ich den manuell hinzufügen.


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: UweD
Geschrieben am: 23.03.2016 10:32:06

Hallo


was hälst du hiervon?

'Code muss in Mappe1
Sub copy()
    Dim WB2 As Workbook, TB1, TB2, LR1&, LR2&, i&, c
    Set TB1 = ActiveWorkbook.Sheets(1)
    LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der SpalteA
    Set WB2 = Workbooks.Open(Filename:="C:\Users\Verein\Desktop\test2.xlsm") 'Kein Readonly
    Set TB2 = WB2.Sheets(1)
    For i = 2 To LR1
        Set c = TB2.Range("A:A").Find(TB1.Cells(i, 1).Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            TB2.Cells(c.Row, 2) = TB1.Cells(i, 2)
            TB2.Cells(c.Row, 6) = TB1.Cells(i, 3)
        Else
            LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
            TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
            TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
        End If
    Next
    WB2.Close savechanges:=True
End Sub
Gruß UweD


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 11:42:25

Hey, vielen Dank schon mal für deine Hilfe!
Das wäre das was ich suche, aber er erstellt mir, wenn die Mitarbeiternummer aus Spalte A im Zieldokument noch nicht vorhanden ist, keine neue Zeile mit den Werten, sondern er mach dann einfach Garnichts.


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: UweD
Geschrieben am: 23.03.2016 11:58:09

kann ich nicht nachvollziehen.


hierdurch wird das realisiert.

        Else
            LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
            TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
            TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
        End If

Dann stell doch mal deine Dateien (abgespeckt) online

Ich lasse offen

Gruß UweD

In meinen Musterdateien klappt das perfekt


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 13:05:44



https://www.herber.de/bbs/user/104561.xlsm
https://www.herber.de/bbs/user/104560.xlsm

Habs jetzt ein paar mal probiert und auch geschaut ob ich vielleicht irgendwo was falsch übernommen habe, aber ich komm nicht drauf. Mitarbeitercode 4747 wird nicht übernommen.


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: UweD
Geschrieben am: 23.03.2016 13:18:28

Du hast in der Zieltabelle ab Zeile 32769 noch Werte stehen und da ist 4747 bei

Wenn du die weglöschst, dann klappt es




Gruß UweD


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 13:36:18

ah, wie die Werte da bloß hingekommen sind. Danke! So funktioniert der Code.
Eine Frage hätte ich noch. Wie muss ich denn den Code abändern, damit er mir nicht nach der letzten Zeile eine neue Zeile einfügt sondern vor der letzten? Weil in die letzte wollte ich eine Summenformel packen, die dann immer da bleiben sollte.


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: UweD
Geschrieben am: 23.03.2016 14:01:24

Hi


Ich würde zwischen Daten und Summenzeile eine Leerzeile lassen.
Also z.B.

- Werte stehen bis Zeile 40
- Leerzeile 41
- Diese leerzeile mit in die Summenformel reinnehmen : in X42=Summe(X2:X41)

Wenn jetzt vor 41 eine Zeile eingefügt wird, muss die Formel nicht abgeändert werden;
die ändert sich automatisch auf =Summe(X2:X42)




Dann wäre das so möglich...

'...
        Else
            LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row - 1
            TB2.Rows(LR2).Insert Shift:=xlDown
            TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
            TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
            TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
        End If
Gruß UweD


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 14:37:49

ok das werde ich so machen. Danke UweD!


  

Betrifft: AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen von: Markus
Geschrieben am: 23.03.2016 14:37:55

ok das werde ich so machen. Danke UweD!


 

Beiträge aus den Excel-Beispielen zum Thema "Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen"