VBA zwei Tabellenblätter miteinander vergleichen und neue Werte ergänzen

  • Excel

Es gibt 13 Antworten in diesem Thema. Der letzte Beitrag () ist von VaporiZed.

    VBA zwei Tabellenblätter miteinander vergleichen und neue Werte ergänzen

    Hallo miteinander,

    aktuell habe ich eine sehr aufwendige VBA – Excel Datei laufen, die viel zu viele Dateien zusammen führt.

    Das will ich etwas beschleunigen und vereinfachen.
    Kann man das Tabellenblatt „Füllung“ mit dem Tabellenblatt „Komplett“ Spalte A miteinander vergleichen und fehlende Werte in Tabelle "Komplett" Spalte A:J anfügen?

    Quasi dass immer nur noch aktuelle Daten an die vorhandene Sammlung Tabelle "Komplett" angefügt werden??

    Vielen Dank schon mal vorab,

    Gruß

    Hi,

    ja klar das kann man.

    Grob:

    Visual Basic-Quellcode

    1. ​
    2. TotalRowsK= Worksheets("Komplett").Rows(osheet.Rows.Count).End(xlUp).Row
    3. TotalRowsF= Worksheets("Füllung").Rows(osheet.Rows.Count).End(xlUp).Row
    4. For a= 1 To TotalRows
    5. If NOT Worksheets("Komplett").Range("A1:A" & TotalRowsK).Find(Worksheets("Füllung").Cells(a,1).Value) IS Nothing then 'suchen nach dem Wert
    6. 'hier iwas machen wenn aus dem Worksheet Füllung der Wert in Komplett nicht gefunden wurde
    7. end if
    8. Next
    Das ist meine Signatur und sie wird wunderbar sein!

    Woran scheiterst du denn?

    Ich habe es bewusst nicht komplett CopyPasta konform aus dem Kopf ungetestet geschrieben.
    Ich gebe dir gerne Hilfestellung. Hast du irgendeinen Plan von VBA?
    Oder willst du eine fertige Lösung?

    Was genau klappt denn nicht usw.. Es ist immer angebracht etwas Initiative zu zeigen ;)
    Das ist meine Signatur und sie wird wunderbar sein!

    Ok, deine Informationen sind leider sehr dünn.
    Ich kann nicht sehen was du siehst und nicht wissen was du genau denkst.
    Was hast du denn bisher bezüglich Code. Was für Daten sind zuviel?

    Vll beschreibst mal näher was dein gesamtes Anliegen ist.

    Hab auch keine Ahnung was du damit zB meinst:
    ​und fehlende Werte in Tabelle "Komplett" Spalte A:J anfügen? Quasi dass immer nur noch aktuelle Daten an die vorhandene Sammlung Tabelle "Komplett" angefügt werden??
    Das ist meine Signatur und sie wird wunderbar sein!

    Ich rufe aktuell viele Dateien ab, die Täglich erweitert werden um eine zusammenfassung zu haben.

    Der Quellcode dafür ist:

    Brainfuck-Quellcode

    1. Sub Lese()
    3. Dim intBereich As Integer
    4. Dim intZeile As Integer
    5. Dim intSpalte As Integer
    6. Dim strDatei As String
    7. Dim intAnzVerz As Integer
    8. Dim intAktVerz As Integer
    9. Dim intAktBlatt As Integer
    10. Dim intAktZeile As Integer
    11. Dim intAktSpalte As Integer
    12. Dim intSpDatum As Integer
    13. Dim intSpBlatt As Integer
    14. Dim intSpDatei As Integer
    15. Dim intSpVerz As Integer
    16. Dim strVerz As String
    17. Dim strVerzA() As String
    18. Dim varDatum As Variant
    19. Dim varKopie As Variant
    20. Dim varRngKopie As Variant
    21. Dim bolLeer As Boolean
    22. Dim rngAusgabe As Range
    23. Dim wbLesen As Workbook
    24. Dim wsLesen As Worksheet
    26. Const intMaxVerz As Integer = 30
    27. Const intMaxblatt As Integer = 2
    28. Const strTeilDatei As String = ".xlsx"
    29. Const strRngDatum As String = "C2"
    30. Const strRngKopie As String = "B3:J55"
    31. Const bolZeigVerz As Boolean = False
    32. Const bolZeigDatei As Boolean = False
    33. Const bolZeigBlatt As Boolean = False
    34. Const bolZeigLeer As Boolean = True
    36. Application.ScreenUpdating = False
    37. '----------------------------------------------------
    38. ' Spalten für Verzeichnis, Datei und Blatt einrichten
    39. '----------------------------------------------------
    40. intSpDatum = 0
    41. intSpBlatt = 0
    42. intSpDatei = 0
    43. intSpVerz = 0
    44. If bolZeigBlatt Then
    45. intSpDatum = intSpDatum + 1
    46. End If
    47. If bolZeigDatei Then
    48. intSpDatum = intSpDatum + 1
    49. intSpBlatt = intSpBlatt + 1
    50. End If
    51. If bolZeigVerz Then
    52. intSpDatum = intSpDatum + 1
    53. intSpBlatt = intSpBlatt + 1
    54. intSpDatei = intSpDatei + 1
    55. End If
    56. varRngKopie = Split(strRngKopie)
    58. '----------------------------------------------------
    59. ' Verzeichniseinlesen und Variablen initialisieren
    60. '----------------------------------------------------
    62. ReDim strVerzA(intMaxVerz)
    63. intAktVerz = 1
    64. intAnzVerz = 1
    65. intAktZeile = 0
    66. strVerzA(intAnzVerz) = ThisWorkbook.Names("Verzeichnis").RefersToRange
    67. Set rngAusgabe = ThisWorkbook.Worksheets("Füllung").Cells(3, 1)
    68. 'Set rngAusgabe = ThisWorkbook.Names("Ausfüllen").RefersToRange
    70. '----------------------------------------------------
    71. ' Schleife über Verzeichnisse
    72. '----------------------------------------------------
    73. While intAktVerz <= intAktVerz And intAktVerz <= intMaxVerz
    74. strVerz = strVerzA(intAktVerz)
    75. strDatei = Dir(strVerz, vbDirectory)
    76. '----------------------------------------------------
    77. ' Schleife über Dateien im Verzeichnis
    78. '----------------------------------------------------
    79. While strDatei <> ""
    80. If (GetAttr(strVerz & strDatei) And vbDirectory) = vbDirectory Then
    81. If strDatei <> "." And strDatei <> ".." And strDatei <> "" And intAnzVerz < intMaxVerz Then
    82. intAnzVerz = intAnzVerz + 1
    83. strVerzA(intAnzVerz) = strVerz & strDatei & "\"
    84. End If
    85. Else
    86. If InStr(strDatei, strTeilDatei) > 0 And strDatei <> ThisWorkbook.Name Then
    87. intAktBlatt = 0
    88. Set wbLesen = Workbooks.Open(Filename:=strVerz & strDatei, ReadOnly:=True)
    89. For Each wsLesen In wbLesen.Worksheets
    90. intAktBlatt = intAktBlatt + 1
    91. If intAktBlatt <= intMaxblatt Then
    92. varDatum = wsLesen.Range(strRngDatum)
    93. For intBereich = 0 To UBound(varRngKopie)
    94. varKopie = wsLesen.Range(varRngKopie(intBereich)).Value
    95. For intZeile = 1 To UBound(varKopie, 1)
    96. '----------------------------------------------------
    97. ' Prüfen ob Werte leer
    98. '----------------------------------------------------
    99. If bolZeigLeer Then
    100. bolLeer = False
    101. Else
    102. bolLeer = True
    103. For intSpalte = 1 To UBound(varKopie, 2)
    104. If varKopie(intZeile, intSpalte) <> "" Then
    105. bolLeer = False
    106. End If
    107. Next intSpalte
    108. End If
    109. '----------------------------------------------------
    110. ' Schreiben wenn nicht leer
    111. '----------------------------------------------------
    112. If Not bolLeer Then
    113. For intSpalte = 1 To UBound(varKopie, 2)
    114. rngAusgabe.Offset(intAktZeile, intSpalte + intSpDatum).Value = varKopie(intZeile, intSpalte)
    115. Next intSpalte
    116. rngAusgabe.Offset(intAktZeile, intSpVerz).Value = strVerz
    117. rngAusgabe.Offset(intAktZeile, intSpDatei).Value = strDatei
    118. rngAusgabe.Offset(intAktZeile, intSpBlatt).Value = wsLesen.Name
    119. rngAusgabe.Offset(intAktZeile, intSpDatum).Value = varDatum
    120. intAktZeile = intAktZeile + 1
    121. End If
    122. Next intZeile
    123. Next intBereich
    124. End If
    125. Next wsLesen
    126. wbLesen.Close savechanges:=False
    127. End If
    128. End If
    129. strDatei = Dir()
    130. Wend
    131. intAktVerz = intAktVerz + 1
    132. Wend
    133. Application.ScreenUpdating = True
    134. End Sub


    Jetzt sind das aber inzwischen zu viele Dateien, wodurch ich immer mal wieder Probleme mit der "Abrufen" Datei bekomme.

    Jetzt war mein Plan, immer nur noch den aktuellen Monat in einem Ordner zu haben, und diesen Ordner abzurufen.

    Im anschluss will ich die abgerufenen und sortierten Daten in dem Tabellenblatt "Füllung" mit dem Tabellenblatt "Komplett" vergleichen und um der neuerungen erweitern.

    Das war jetzt der ganze Plan.

    Ergo Spalte A von Tabellenblatt "Füllung" mit Spalte A Tabellenblatt "Komplett" vergleichen und neuerungen im Tabellenblatt "Komplett" anfügen.

    Die Werte die anzufügen sind, befinden sich in Spalte A bis J.

    Visual Basic-Quellcode

    1. ​
    3. TotalRowsK = Worksheets("Komplett").Cells(Worksheets("Komplett").Rows.Count, "A").End(xlUp).Row 'letzte Zeile aus Blatt Komplett
    4. TotalRowsF = Worksheets("Füllung").Cells(Worksheets("Füllung").Rows.Count, "A").End(xlUp).Row 'letzte Zeile aus Blatt Füllung
    5. Dim fRange As Range
    6. Dim rowsK As Long
    7. Dim findWhat As String
    8. currentRowK = TotalRowsK + 1 'erste leere Zeile in Komplett
    9. For a = 1 To TotalRowsF 'von erster bis letzte Zeile durchgehen und in Komplett danach suchen
    10. findWhat = Worksheets("Füllung").Cells(a, 1).Value
    12. If findWhat <> "" Then
    13. Set fRange = Worksheets("Komplett").Range("A1:A" & TotalRowsK).Find(findWhat, LookIn:=xlValues, lookat:=xlWhole)
    15. If fRange Is Nothing Then 'suchen nach dem Wert
    16. 'hier iwas machen wenn aus dem Worksheet Füllung der Wert in Komplett nicht gefunden wurde
    18. Worksheets("Komplett").Range("A" & currentRowK & ":J" & currentRowK).Value = Worksheets("Füllung").Range("A" & a & ":J" & a).Value 'value von Spalte A bis J aus der Zeile kopieren
    19. currentRowK = currentRowK + 1 ' eine Zeile weiter
    20. Else
    21. 'wenn gefunden dann nix machen (oder)
    22. End If
    23. End If
    24. Next


    Falls ich dich richtig verstanden habe dann sollte das hier jetzt funkionieren.

    LG
    Das ist meine Signatur und sie wird wunderbar sein!

    Hey Mono,

    du bist mein Retter!!!

    Das funktioniert perfekt!!!!!!

    Vielen vielen Dank!!!!

    Nachtrag:

    Wie schon geschrieben, du bist mein Retter!! Nur ein problem bleitbt. Spalte A ist in erster Linie ein Datum. Er setzt das abgerufene dennoch unten an, obwohl das schon vorhanden ist.

    Ggf. gibt es da eine einfache Erklärung.

    Vielen, vielen Dank und Gruß

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „tw3aker“ ()

    Mono schrieb:

    Visual Basic-Quellcode (24 Zeilen)

    Falls ich dich richtig verstanden habe dann sollte das hier jetzt funkionieren.

    LG


    Hallo Mono,

    ich bin bei meiner Bing-Suche auf diesen Beitrag gestoßen und Dein Code hat mir bei einem sehr ähnlichen Problem geholfen!
    Daher habe ich mich hier im Forum registriert, um Dir meinen Danz zu übermitteln.
    Du hast mir bei meinem Problem geholfen und erstparst mir einiges an Arbeit.
    Danke!

    Gruß

    OLLI

    Schön, dass Dir geholfen werden konnte. Deshalb aber einen Uralt-Thread wiederzubeleben, wird hier allerdings nicht gern gesehen. Ne persönliche Nachricht an Mono + eine Hilfreich-Bewertung hätte gereicht.
    *closed
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

Facebook
Telefonspende