Microsoft Excel

Herbers Excel/VBA-Archiv

Datenabgleich über zwei Blätter


Betrifft: Datenabgleich über zwei Blätter von: Georg
Geschrieben am: 01.10.2019 14:48:09

Liebe Mitglieder, die Beispielsdate ist hier:

https://www.herber.de/bbs/user/132312.xlsx

Das Ganze übersteigt glaube ich etwas meine Kenntnisse, der Code steht unten als Versuch.
Es soll von Blatt Skills fehlende Zeilen anhand der P-Nummer in Spalte A ins Blatt Costs kopiert werden.
Der Code läuft, er kopiert aber immer nur den letzten fehlenden, im Beispiel müssten 2 Datensätze kopiert werden.
Und zusätzlich möchte ich die Tabelle im Blatt Costs fortsetzen mit den fehlenden Zeilen. Der Code fügt aber diese eine Zeile unterhalb der Tabelle ein.

Dass die Spalten nciht übereinstimmen, ist zweitrangig, korrigiere ich an anderer Stelle.

Vielen Dank für eure Tipps!! G

Sub FehlendeDS()
    Dim LoI As Long
    Dim lgLastCost As Long
    Dim lgLastSkill As Long
    Dim RaFound As Range                            '
    Dim wsCosts As Worksheet
    Dim wsSkills As Worksheet
    Application.ScreenUpdating = False              '   
    Set wsCosts = Worksheets(1)               ' setzen Tabelle1
    Set wsSkills = Worksheets(2)               ' setzen Tabelle2
    
                        With wsCosts                                       ' letzte Zeile  _
Spalte D P-Nummern in Kosten ermitteln
                            lgLastCost = IIf(IsEmpty(.Cells(Rows.Count, 4)), _
                                .Cells(Rows.Count, 4).End(xlUp).Row, .Rows.Count)
                        End With
                        With wsSkills                                       ' letzte Zeile  _
Spalte B P-Nummern in Skills ermitteln
                            lgLastSkill = IIf(IsEmpty(.Cells(Rows.Count, 1)), _
                                .Cells(Rows.Count, 1).End(xlUp).Row, .Rows.Count)
                        End With

    For LoI = 2 To lgLastSkill                        ' Schleife über Kopie
        If wsSkills.Cells(LoI, 1) <> "" Then
            Set RaFound = wsCosts.Range("D2:J" & lgLastCost).Find(wsSkills.Cells(LoI, 1), _
                wsCosts.Range("D" & lgLastCost), , xlWhole, , xlNext)
            If RaFound Is Nothing Then          ' Begriff gefunden
                wsSkills.Rows(LoI).Copy         ' gefundene Zeile kopieren
                With Worksheets(1)
                    '
                    .Rows(lgLastCost + 1).PasteSpecial Paste:=xlValues
                    ' Formate übertragen
                    .Rows(lgLastCost + 1).PasteSpecial Paste:=xlFormats
                   
                End With
            End If
        End If
    Next LoI
    Application.CutCopyMode = False
    Application.ScreenUpdating = True               ' Bildschirmaktualisierung ein
End Sub

  

Betrifft: AW: Datenabgleich über zwei Blätter von: Hajo_Zi
Geschrieben am: 01.10.2019 16:58:04

das geht nicht, da eine XLSX Datei kein Makro enthalten kann.
Ich sehe keinen Grund eine Datei 2x zu speichern und den Code einzufügen.
Ich führe keine Liste unter welchem Dateinamen ich die Datei aus dem Forum gespeichert habe gespeichert habe.
Der Name steht ja im Beitrag.


GrußformelHomepage


  

Betrifft: AW: Datenabgleich über zwei Blätter von: Georg
Geschrieben am: 01.10.2019 17:14:34

Auch wenn ich meine VBA Kenntnisse als bescheiden angegeben habe, soweit reichts dann doch noch, dass es mit xlsx nicht geht..
Bisher konnte man keine xlsm Datei im Forum abspeichern, falls sich das geändert habe, habe ich es nicht mitgekriegt.
Vielleicht hat ja j-d doch noch eine Idee, wo der Haken ist, wenn man den Code in die Beispielsdatei einfügt und unter xlsm :-) abspeichert.
Falls ich die Datei als xlsm Datei hier hochladen kann, tue ich das natürlich gerne. Gebt Bescheid
Vielen Dank. G


  

Betrifft: AW: Datei zurück... von: Helmut
Geschrieben am: 01.10.2019 18:28:34

https://www.herber.de/bbs/user/132317.xlsm

Hallo,

letzte Zeile ermitteln neu eingebaut..

Gruß Helmut


  

Betrifft: AW: Datei zurück... und vielen Dank Helmut.. von: Georg
Geschrieben am: 01.10.2019 19:33:25

..Gruß Georg


  

Betrifft: AW: Datenabgleich über zwei Blätter von: Piet
Geschrieben am: 01.10.2019 18:28:49

Hallo Georg

du kannst .xlsm Dateien im Forum speichern, mache ich auch, aber nicht jeder öffnet sie!
Alternativ kannst du die Makros in eine Tabelle kopieren, das Modul notieren, und als xlsx hochladen.

mfg Piet


  

Betrifft: AW: Datenabgleich über zwei Blätter von: volti
Geschrieben am: 01.10.2019 19:00:18

Hallo Georg,

hier noch eine kleine Alternative (als Anregung, ggf. zum Ausbauen) für Dein Vorhaben:

Sub FehlendeDS()
 Dim wsCosts As Worksheet, iSpalte As Integer, iZeile As Long, iOutZeile As Long, Gefunden As Long
 Application.ScreenUpdating = False
 Set wsCosts = ThisWorkbook.Sheets("Costs")                     'Blatt-Object setzen
 iOutZeile = wsCosts.Cells(Rows.Count, 4).End(xlUp).Row + 1     'Nächste Zeilennummer zum Einfügen
 With ThisWorkbook.Sheets("Skills")
   On Error Resume Next
   For iZeile = 2 To .Cells(Rows.Count, 4).End(xlUp).Row        'Alle Zeilen in Skills duchgehen
    Gefunden = 0
    Gefunden = Application.WorksheetFunction.Match(.Cells(iZeile, "A").Value, wsCosts.Range("D:D"), 0)
    If Gefunden = 0 Then
      For iSpalte = 1 To 6
        wsCosts.Cells(iOutZeile, iSpalte + 3).Value = .Cells(iZeile, iSpalte).Value
      Next iSpalte
      iOutZeile = iOutZeile + 1
    End If
   Next iZeile
 End With
 Application.ScreenUpdating = True
End Sub


Es war nicht ganz erkennbar, ob Du die fehlenden Zeilen einsortiert haben wolltest oder sie einfach untendrunter sein sollen. Es würde sich ohnehin eine Neuformatierung des ganzen Blattes nach den Ergänzungen anbieten, damit nicht u.U. blau auf blau oder weiß auf weiß kommt.
Bei meinem Test hier wird die jeweilige neue Zeile (Win10, Off 365) gleich von Excel farblich blau/weiß weitergeführt, obwohl ich kein Format übernommen habe.

viele Grüße
Karl-Heinz


  

Betrifft: AW: Datenabgleich über zwei Blätter..danke.. von: Georg
Geschrieben am: 01.10.2019 19:35:27

..Karl-Heinz, werde es morgen mal testen. Beste Grüße Georg


Beiträge aus dem Excel-Forum zum Thema "Datenabgleich über zwei Blätter"