Per Makro doppelte Werte aus 2 Tabellenblättern

  • Excel

Es gibt 7 Antworten in diesem Thema. Der letzte Beitrag () ist von Baem.

    Per Makro doppelte Werte aus 2 Tabellenblättern

    Hallo zusammen,

    ich wollte fragen ob mir hier wer helfen kann.

    Ist es möglich, dass mir ein Makro ausliest, wie viele Werte aus dem Tabellenblatt 2 mit dem von Tabellenblatt 3 übereinstimmen und welche nicht? Die Daten die keine Übereinstimmung haben sollen mir aufgelistet werden.

    Das Makro müsste hierfür nur in der Spalte A suchen (Tabelle2!A:A) und (Tabelle3!A:A) müssten hier abgefragt werden. In Tabelle1 will ich die Abfrage starten, hier sollte mir dann auch aufgelistet werden, was keine Übereinstimmung hat.

    Danke im Voraus und LG
    Benny

    Baem schrieb:

    Ist es möglich, dass mir ein Makro ausliest, wie viele Werte aus dem Tabellenblatt 2 mit dem von Tabellenblatt 3 übereinstimmen und welche nicht?
    Ja.

    Aber ich würde das mit bedingter Formatierung lösen und in Tabelle2 alle Felder, die nicht mit Tabelle3 übereinstimmen, farblich markieren.
    Da brauchst du kein VBA.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

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

    Hallo Benny,

    Spoiler anzeigen
    ]

    VB.NET-Quellcode

    1. Public AktuelleMatrix As String
    2. Public StartSpalte As Variant
    3. Public StartZeile As Variant
    4. Public EndeSpalte As Variant
    5. Public EndeZeile As Variant
    6. Public AktuelleZelle As String
    7. Public Z As Integer
    8. Public ZZ As Integer
    9. Public Spalte As Integer
    10. Public Zeile As Integer
    11. Public t As String
    12. Public Function NeuerSVerweis(Suchkriterium As String, Datenbereich As Range, Optional Suchspalte As Variant = 1, Optional RückgabeSpalte As Variant = 2, Optional RückgabewertBeiNichtGefunden As String = "Nicht vorhanden") As Variant
    13. ' Zeigt den Spaltenwert der Zeile an, in der das Suchkriterium dem Zeilenwert entspricht. Der zu durchsuchende Datenbereich muß nicht sortiert oder besonders aufbereitet werden.
    14. ' Hinweis: Bei Aufrufen der Funktion STRG+ALT+A drücken, damit man die Eingabeparameter sehen kannn. Ansonsten über das Einfügen einer Funktion gehen
    15. ' Funktion automatisch neu berechnen
    16. Application.Volatile
    17. ' Application.MacroOptions Macro:="NeuerSVerweis", Description:="Suchkriterium = Zelle, die verglichen werden soll" & Chr(13) & "Tabellename = Tabellenname in Anführungszeichen der Matrix" & Chr(13) & "Datenbereich = absoluter ($) Datenbereich" & Chr(13) & "RückgabeSpalte = Wertespalte der Matrix, die angezeigt werden soll" & Chr(13) & "RückgabewertBeiNichtGefunden = Anzeige, wenn Suchkriterium nicht in Matrix ", Category:=5"
    18. Dim DatenbereichString As String
    19. ' Aufruf: =NeuerSVerweis(A1;"Tabelle1!$E$1:$G$14";2;1;"Fehler")
    20. 'Aus $A$1:$A$3 die Spalten und Zeilenzahl ermitteln
    21. DatenbereichString = Datenbereich.Address
    22. ' Den Tabellennamen ermitteln
    23. Tabellename = Datenbereich.Worksheet.Name
    24. ' Wenn kein Tabellenname angegeben ist, dann die aktuelle Tabelle nehmen
    25. If Tabellename = "" Then
    26. Tabellename = ActiveWorkbook.ActiveSheet.Name
    27. End If
    28. If InStr(1, Tabellename, "[") > 0 Then
    29. SuchmatrixDateiname = Mid(Tabellename, 1 + InStr(1, Tabellename, "["), InStr(1, Tabellename, "]") - 2)
    30. Tabellename = Mid(Tabellename, InStr(1, Tabellename, "]") + 1, Len(Tabellename))
    31. End If
    32. spalte1 = Range(Mid(DatenbereichString, 2, InStr(2, DatenbereichString, "$") - 2) & "1").Column
    33. spalte2 = Mid(DatenbereichString, InStr(1, DatenbereichString, ":") + 2, InStr(InStr(1, DatenbereichString, ":") + 2, DatenbereichString, "$") - 2)
    34. spalte2 = Mid(spalte2, 1, InStr(1, spalte2, "$") - 1)
    35. spalte2 = Range(spalte2 & "1").Column
    36. t = Spaltennr_in_Spaltenname(spalte1)
    37. Zeile1 = Mid(DatenbereichString, InStr(2, DatenbereichString, "$") + 1, InStr(1, DatenbereichString, ":") - (InStr(2, DatenbereichString, "$") + 1))
    38. Zeile1 = Range(t & Mid(DatenbereichString, InStr(2, DatenbereichString, "$") + 1, InStr(1, DatenbereichString, ":") - (InStr(2, DatenbereichString, "$") + 1))).Row
    39. Zeile2 = Mid(DatenbereichString, InStr(InStr(1, DatenbereichString, ":") + 2, DatenbereichString, "$") + 1, 7)
    40. ' Nun der Suchspalte evtl. noch die leeren Vorspalten dazugeben
    41. Suchspalte = spalte1 + Suchspalte - 1
    42. ' Standardrückgabewert festlegen
    43. NeuerSVerweis = RückgabewertBeiNichtGefunden
    44. ' Prüfen, ob die Rückgabespalte größer/kleiner als der Datenbereich ist
    45. If RückgabeSpalte <= 0 Or RückgabeSpalte > spalte2 - spalte1 + 1 Then
    46. MsgBox "Die Rückgabespalte " & RückgabeSpalte & " ist größer als die Anzahl der Spalten des Datenbereiches bzw. ist kleiner/gleich 0."
    47. Exit Function
    48. End If
    49. ' Nun den DatenbereichString nach dem Suchkreterium durchsuchen
    50. For Z = Zeile1 To Zeile2
    51. For S = spalte1 To spalte2
    52. If SuchmatrixDateiname <> "" Then
    53. If Trim(Suchkriterium) = Trim(Workbooks(SuchmatrixDateiname).Worksheets(Tabellename).Cells(Z, S).Value) Then
    54. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    55. GoTo NeuerSVerweis_Ende
    56. End If
    57. Else
    58. If Suchspalte = 0 Then
    59. If Trim(Suchkriterium) = Trim(Worksheets(Tabellename).Cells(Z, S).Value) Then
    60. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    61. GoTo NeuerSVerweis_Ende
    62. End If
    63. Else
    64. If Trim(Suchkriterium) = Trim(Worksheets(Tabellename).Cells(Z, Suchspalte).Value) Then
    65. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    66. GoTo NeuerSVerweis_Ende
    67. End If
    68. End If
    69. End If
    70. Next S
    71. Next Z
    72. NeuerSVerweis_Ende:
    73. End Function
    74. Public Function Spaltennr_in_Spaltenname(Spaltennr As Variant) As String
    75. Dim ErsterSpaltenbuchstabe As Integer
    76. Dim Buchstabenzähler As Integer
    77. ErsterSpaltenbuchstabe = 0
    78. Buchstabenzähler = 0
    79. For Z = 1 To Spaltennr
    80. Buchstabenzähler = Buchstabenzähler + 1
    81. If Buchstabenzähler > 26 Then
    82. ErsterSpaltenbuchstabe = ErsterSpaltenbuchstabe + 1
    83. Buchstabenzähler = 0
    84. End If
    85. Next Z
    86. If ErsterSpaltenbuchstabe > 0 Then
    87. Spaltennr_in_Spaltenname = Chr(64 + ErsterSpaltenbuchstabe) & Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    88. Else
    89. Spaltennr_in_Spaltenname = Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    90. End If
    91. End Function


    Versuch es mal damit.

    Eigentlich kann man das auch mit dem normalen SVerweis lösen. Bei diesem SVerweis müssen aber die Daten die durchsucht werden sollen ein paar Bedingungen haben

    1. Die Suchspalte muss die erste Spalte sein, bevor die restlichen Daten kommen.
    2. Die Daten müssen nach dieser Suchspalte aufsteigend sortiert sein.
    3. Wenn es keinen Treffer gibt, wird die nächste Zeile zurückgegeben, was dann aber falsch ist.

    Aus diesem Grund habe ich mir schon damals einen Neuen-Sverweis gebastelt, der diese Probleme nicht hat.

    Er braucht zwar ein paar übergabeparameter mehr als der SVerweis, ist dann aber effektiver. Die Daten müssen nicht sortiert sein, die Suchspalte muss nicht vorne stehen und einen Text für keinen Treffer kann auch zurückgegeben werden.

    Probier einfach mal den NeuerSVerweis aus.

    Gruß

    Volker
    @Volker Bunge:
    Ich habe deinen Code zwar nicht getestet, aber so richtig gefallen tut er mir nicht.
    Was mir schon alleine beim groben Anschauen auffällt:
    - Du arbeitest mit Variant anstatt mit exakter Typdefinition.
    Das ist nicht ungefährlich und vor allem unübersichtlich.
    - Du verwendest GoTo.
    Ein Exit Function wäre an diesen Stellen angebrachter.
    - Deine Variablen enthalten Umlaute.
    Das kann Probleme geben in internationalen Umgebungen (wenn ein Kollege aus USA oder Japan daran arbeitet).
    - Deine Funktion ist eine UDF (User Defined Function)
    das ist bei grösseren Tabellen sehr langsam
    - Du loopst durch die Zeilen.
    Ein Find / FindNext ist wesentlich schneller
    - Die Funktion funktioniert nur innerhalb der ersten 26 Spalten.

    Die restlichen Einschränkungen hast du ja schon selbst aufgelistet.

    Sorry. Ich wollte dich jetzt nicht brüskieren.
    Aber unkommentiert stehen lassen kann ich es auch nicht.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo petaod,

    natürlich hast Du mit 'Goto' vollkommen recht (also 70, 76 und 81 ersetzen und Zeile 88 löschen)

    Die Umlaute stimme ich Dir auch soweit zu. Ist leider noch eine große Schwäche von mir, es mit Umlauten zu machen. (RückgabeSpalte, RückgabewertBeiNichtGefunden, Buchstabenzähler) müsste man ändern.

    Diese Zeile 2-5 müssen somit

    Public StartSpalte As Integer
    Public StartZeile As Integer
    Public EndeSpalte As Integer
    Public EndeZeile As Integer

    lauten.

    Die beiden anderen Punkte
    'Ein Find / FindNext ist wesentlich schneller- Die Funktion funktioniert nur innerhalb der ersten 26 Spalten.' stimmen auch.

    Werde ich mal bei Gelegenheit überarbeiten.

    Das mit dem 'brüskieren' ist schon in Ordnung. Bin ja auch nicht immer perfekt. Die o. g. Fehler habe ich erst gesehen, als Du Sie genannt hast.

    Gruß
    Volker

    Volker Bunge schrieb:

    Public StartZeile As Integer
    Public EndeSpalte As Integer
    Public EndeZeile As Integer
    Für die Spalten ist ein Integer OK.
    Für die Zeilen musst du streng genommen ein Long nehmen, da ein Worksheet mehr als 32767 Zeilen haben kann.
    Kommt selten vor, aber wenn, dann klemmt's plötzlich unerwartet an Stellen, die sonst immer funktionieren.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo petaod, Hallo Benny,

    hab noch mal etwas programmiert. Hier mein neuer SVerweis

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Enum Suchgenauigkeit_Enum
    2. Genau = 1
    3. Teil = 2
    4. End Enum
    5. Public Function NeuerSVerweis(Suchkriterium As String, Tabellenname As String, Datenbereich As String, Suchgenauigkeit As Suchgenauigkeit_Enum, Optional Suchspalte As Integer = 1, Optional RueckgabeSpalte As Integer = 2, Optional RueckgabewertBeiNichtGefunden As String = "Nicht vorhanden") As Variant
    6. Dim Bereich As Range
    7. ' Wenn kein Suchkriterium angegeben ist, dann Funktion verlassen
    8. If Suchkriterium = "" Then
    9. NeuerSVerweis = "Suchkriterium fehlt."
    10. Exit Function
    11. End If
    12. Set Bereich = Sheets(Tabellenname).Range(Datenbereich).Find(Suchkriterium, LookAt:=Suchgenauigkeit, LookIn:=xlValues)
    13. If Bereich Is Nothing Then
    14. ' Kein Treffer
    15. NeuerSVerweis = RueckgabewertBeiNichtGefunden
    16. Else
    17. ' Bei einem Treffer wird die Spalte zurückgeliefert, die man haben möchte
    18. NeuerSVerweis = Sheets(Tabellenname).Range(Cells(Bereich.Row, RueckgabeSpalte), Cells(Bereich.Row, RueckgabeSpalte)).Value
    19. End If
    20. End Function


    Da ich es doch recht kompliziert aufgezogen habe, sind aber doch noch ein paar Hilfsfunktionen bei rum gekommen. Diese werden zwar hier überhaupt nicht benötigt, könnten aber an anderer Stelle hilfreich sein.

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Enum RangeBereichRueckgabewertEnum
    2. StartSpaltennr = 1
    3. StartZeilenNr = 2
    4. EndeSpaltenNr = 3
    5. EndeZeilenNr = 4
    6. End Enum
    7. Public Function Spaltennr_in_Spaltenname(Spaltennr As Variant) As String
    8. Dim ErsterSpaltenbuchstabe As Integer
    9. Dim Buchstabenzaehler As Integer
    10. ErsterSpaltenbuchstabe = 0
    11. Buchstabenzaehler = 0
    12. For Z = 1 To Spaltennr
    13. Buchstabenzaehler = Buchstabenzaehler + 1
    14. If Buchstabenzaehler > 26 Then
    15. ErsterSpaltenbuchstabe = ErsterSpaltenbuchstabe + 1
    16. Buchstabenzaehler = 0
    17. End If
    18. Next Z
    19. If ErsterSpaltenbuchstabe > 0 Then
    20. Spaltennr_in_Spaltenname = Chr(64 + ErsterSpaltenbuchstabe) & Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    21. Else
    22. Spaltennr_in_Spaltenname = Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    23. End If
    24. End Function
    25. Public Function DatenRange_auswerten(RangeBereich As String, Rueckgabe As RangeBereichRueckgabewertEnum)
    26. ' Hier wird der übergebene RangeBereich (Bsp: AD3:DD356) so zerlegt, dass am Ende über die Rückgabe folgende Werte zurückgeliefert werden können
    27. ' Start Spaltennr
    28. ' Start ZeilenNr
    29. ' Ende SpaltenNr
    30. ' Ende ZeilenNr
    31. ' Also hier 30, 3, 108, 356
    32. ' Ein paar Hilfsvariablen festlegen
    33. Dim Wert(4) As String
    34. ' Die Großschreibung sicherstellen
    35. RangeBereich = UCase(RangeBereich)
    36. ' Also hier erst einmal die vier Bereiche separieren
    37. ' Prüfen, ob der Start unter AA liegt oder nicht
    38. If Val(Mid(RangeBereich, 2, 1)) > 0 Then
    39. ' Startadresse
    40. Wert(1) = Mid(RangeBereich, 1, 1)
    41. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    42. Wert(1) = Val(Asc(Mid(Wert(1), 1, 1)) - 64)
    43. ' den Rangebereich um die Buchstaben kürzen
    44. RangeBereich = Mid(RangeBereich, 2)
    45. Else
    46. ' Startadresse
    47. Wert(1) = Mid(RangeBereich, 1, 2)
    48. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    49. Wert(1) = Val((Asc(Mid(Wert(1), 1, 1)) - 64) * 26) + Val((Asc(Mid(Wert(1), 2, 1)) - 64))
    50. ' den Rangebereich um die Buchstaben kürzen
    51. RangeBereich = Mid(RangeBereich, 3)
    52. End If
    53. ' Jetzt noch die Startzeile ermitteln
    54. Wert(2) = Mid(RangeBereich, 1, InStr(1, RangeBereich, ":") - 1)
    55. RangeBereich = Mid(RangeBereich, InStr(1, RangeBereich, ":") + 1)
    56. ' Prüfen, ob das Ende unter AA liegt oder nicht
    57. If Val(Mid(RangeBereich, 2, 1)) > 0 Then
    58. ' Endadresse
    59. Wert(3) = Mid(RangeBereich, 1, 1)
    60. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    61. Wert(3) = Val(Asc(Mid(Wert(3), 1, 1)) - 64)
    62. ' den Rangebereich um die Buchstaben kürzen und somit die Endzeile erhalten
    63. Wert(4) = Mid(RangeBereich, 2, 100)
    64. Else
    65. ' Endadresse
    66. Wert(3) = Mid(RangeBereich, 1, 2)
    67. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    68. Wert(3) = Val((Asc(Mid(Wert(3), 1, 1)) - 64) * 26) + Val(Asc(Mid(Wert(3), 2, 1)) - 64)
    69. ' den Rangebereich um die Buchstaben kürzen
    70. Wert(4) = Mid(RangeBereich, 3, 100)
    71. End If
    72. ' Nun noch den gewünschten Wert zurückliefern
    73. DatenRange_auswerten = Wert(Rueckgabe)
    74. End Function


    @petrod: Deinen letzen Post habe ich berücksichtig. Fällt aber mit der neuen Variante weg.

    Anmerkung: Dieser SVerweis (und auch mein alter) können natürlich nur dann richtig funktionieren, wenn es das Suchkriterium nur einmal gibt. Ist es mehrmals vorhanden, dann wird nur der erste von oben gefunden.

    Gruß
    Volker

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

    Hallo zusammen,

    danke für eure Tipps und eure Hilfe.

    @Volker Bunge: Wegen deinem letzten Eintrag... Es geht darum, dass aktuell 513 verschiedene Einträge vorhanden sind. Beim nächsten Mal werden es mehrere sein (welche in Tabelle2) eingetragen werden und das Makro soll mir dann auslesen, welcher der Einträge vorher nicht dabei war (dies kann 1-5 neue Inhalte bedeuten).

    Also nach einem einzigen Suchkriterium suchen hilft hier leider nicht. Danke aber dennoch vielmals für deine/eure Bemühungen. :)


    Hab es jetzt mit der ZÄHLENWENN-Funktion gemacht - tut auch so ihren Zweck. :)

    LG
    Benny