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
    13. 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
    14. ' Zeigt den Spaltenwert der Zeile an, in der das Suchkriterium dem Zeilenwert entspricht. Der zu durchsuchende Datenbereich muß nicht sortiert oder besonders aufbereitet werden.
    15. ' Hinweis: Bei Aufrufen der Funktion STRG+ALT+A drücken, damit man die Eingabeparameter sehen kannn. Ansonsten über das Einfügen einer Funktion gehen
    17. ' Funktion automatisch neu berechnen
    18. Application.Volatile
    20. ' 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"
    21. Dim DatenbereichString As String
    23. ' Aufruf: =NeuerSVerweis(A1;"Tabelle1!$E$1:$G$14";2;1;"Fehler")
    25. 'Aus $A$1:$A$3 die Spalten und Zeilenzahl ermitteln
    26. DatenbereichString = Datenbereich.Address
    28. ' Den Tabellennamen ermitteln
    29. Tabellename = Datenbereich.Worksheet.Name
    31. ' Wenn kein Tabellenname angegeben ist, dann die aktuelle Tabelle nehmen
    32. If Tabellename = "" Then
    33. Tabellename = ActiveWorkbook.ActiveSheet.Name
    34. End If
    36. If InStr(1, Tabellename, "[") > 0 Then
    37. SuchmatrixDateiname = Mid(Tabellename, 1 + InStr(1, Tabellename, "["), InStr(1, Tabellename, "]") - 2)
    38. Tabellename = Mid(Tabellename, InStr(1, Tabellename, "]") + 1, Len(Tabellename))
    39. End If
    41. spalte1 = Range(Mid(DatenbereichString, 2, InStr(2, DatenbereichString, "$") - 2) & "1").Column
    42. spalte2 = Mid(DatenbereichString, InStr(1, DatenbereichString, ":") + 2, InStr(InStr(1, DatenbereichString, ":") + 2, DatenbereichString, "$") - 2)
    43. spalte2 = Mid(spalte2, 1, InStr(1, spalte2, "$") - 1)
    44. spalte2 = Range(spalte2 & "1").Column
    46. t = Spaltennr_in_Spaltenname(spalte1)
    47. Zeile1 = Mid(DatenbereichString, InStr(2, DatenbereichString, "$") + 1, InStr(1, DatenbereichString, ":") - (InStr(2, DatenbereichString, "$") + 1))
    48. Zeile1 = Range(t & Mid(DatenbereichString, InStr(2, DatenbereichString, "$") + 1, InStr(1, DatenbereichString, ":") - (InStr(2, DatenbereichString, "$") + 1))).Row
    50. Zeile2 = Mid(DatenbereichString, InStr(InStr(1, DatenbereichString, ":") + 2, DatenbereichString, "$") + 1, 7)
    52. ' Nun der Suchspalte evtl. noch die leeren Vorspalten dazugeben
    53. Suchspalte = spalte1 + Suchspalte - 1
    55. ' Standardrückgabewert festlegen
    56. NeuerSVerweis = RückgabewertBeiNichtGefunden
    58. ' Prüfen, ob die Rückgabespalte größer/kleiner als der Datenbereich ist
    59. If RückgabeSpalte <= 0 Or RückgabeSpalte > spalte2 - spalte1 + 1 Then
    60. MsgBox "Die Rückgabespalte " & RückgabeSpalte & " ist größer als die Anzahl der Spalten des Datenbereiches bzw. ist kleiner/gleich 0."
    61. Exit Function
    62. End If
    64. ' Nun den DatenbereichString nach dem Suchkreterium durchsuchen
    65. For Z = Zeile1 To Zeile2
    66. For S = spalte1 To spalte2
    67. If SuchmatrixDateiname <> "" Then
    68. If Trim(Suchkriterium) = Trim(Workbooks(SuchmatrixDateiname).Worksheets(Tabellename).Cells(Z, S).Value) Then
    69. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    70. GoTo NeuerSVerweis_Ende
    71. End If
    72. Else
    73. If Suchspalte = 0 Then
    74. If Trim(Suchkriterium) = Trim(Worksheets(Tabellename).Cells(Z, S).Value) Then
    75. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    76. GoTo NeuerSVerweis_Ende
    77. End If
    78. Else
    79. If Trim(Suchkriterium) = Trim(Worksheets(Tabellename).Cells(Z, Suchspalte).Value) Then
    80. NeuerSVerweis = Worksheets(Tabellename).Cells(Z, spalte1 + RückgabeSpalte - 1).Value
    81. GoTo NeuerSVerweis_Ende
    82. End If
    83. End If
    84. End If
    85. Next S
    86. Next Z
    88. NeuerSVerweis_Ende:
    90. End Function
    92. Public Function Spaltennr_in_Spaltenname(Spaltennr As Variant) As String
    93. Dim ErsterSpaltenbuchstabe As Integer
    94. Dim Buchstabenzähler As Integer
    96. ErsterSpaltenbuchstabe = 0
    97. Buchstabenzähler = 0
    99. For Z = 1 To Spaltennr
    100. Buchstabenzähler = Buchstabenzähler + 1
    101. If Buchstabenzähler > 26 Then
    102. ErsterSpaltenbuchstabe = ErsterSpaltenbuchstabe + 1
    103. Buchstabenzähler = 0
    104. End If
    105. Next Z
    107. If ErsterSpaltenbuchstabe > 0 Then
    108. Spaltennr_in_Spaltenname = Chr(64 + ErsterSpaltenbuchstabe) & Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    109. Else
    110. Spaltennr_in_Spaltenname = Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    111. End If
    112. 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
    8. ' Wenn kein Suchkriterium angegeben ist, dann Funktion verlassen
    9. If Suchkriterium = "" Then
    10. NeuerSVerweis = "Suchkriterium fehlt."
    11. Exit Function
    12. End If
    14. Set Bereich = Sheets(Tabellenname).Range(Datenbereich).Find(Suchkriterium, LookAt:=Suchgenauigkeit, LookIn:=xlValues)
    16. If Bereich Is Nothing Then
    17. ' Kein Treffer
    18. NeuerSVerweis = RueckgabewertBeiNichtGefunden
    19. Else
    20. ' Bei einem Treffer wird die Spalte zurückgeliefert, die man haben möchte
    21. NeuerSVerweis = Sheets(Tabellenname).Range(Cells(Bereich.Row, RueckgabeSpalte), Cells(Bereich.Row, RueckgabeSpalte)).Value
    22. End If
    23. 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
    7. End Enum
    8. Public Function Spaltennr_in_Spaltenname(Spaltennr As Variant) As String
    9. Dim ErsterSpaltenbuchstabe As Integer
    10. Dim Buchstabenzaehler As Integer
    12. ErsterSpaltenbuchstabe = 0
    13. Buchstabenzaehler = 0
    15. For Z = 1 To Spaltennr
    16. Buchstabenzaehler = Buchstabenzaehler + 1
    17. If Buchstabenzaehler > 26 Then
    18. ErsterSpaltenbuchstabe = ErsterSpaltenbuchstabe + 1
    19. Buchstabenzaehler = 0
    20. End If
    21. Next Z
    23. If ErsterSpaltenbuchstabe > 0 Then
    24. Spaltennr_in_Spaltenname = Chr(64 + ErsterSpaltenbuchstabe) & Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    25. Else
    26. Spaltennr_in_Spaltenname = Chr(64 + (Z - (ErsterSpaltenbuchstabe * 26) - 1))
    27. End If
    28. End Function
    29. Public Function DatenRange_auswerten(RangeBereich As String, Rueckgabe As RangeBereichRueckgabewertEnum)
    30. ' Hier wird der übergebene RangeBereich (Bsp: AD3:DD356) so zerlegt, dass am Ende über die Rückgabe folgende Werte zurückgeliefert werden können
    31. ' Start Spaltennr
    32. ' Start ZeilenNr
    33. ' Ende SpaltenNr
    34. ' Ende ZeilenNr
    35. ' Also hier 30, 3, 108, 356
    37. ' Ein paar Hilfsvariablen festlegen
    38. Dim Wert(4) As String
    40. ' Die Großschreibung sicherstellen
    41. RangeBereich = UCase(RangeBereich)
    43. ' Also hier erst einmal die vier Bereiche separieren
    44. ' Prüfen, ob der Start unter AA liegt oder nicht
    45. If Val(Mid(RangeBereich, 2, 1)) > 0 Then
    46. ' Startadresse
    47. Wert(1) = Mid(RangeBereich, 1, 1)
    49. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    50. Wert(1) = Val(Asc(Mid(Wert(1), 1, 1)) - 64)
    52. ' den Rangebereich um die Buchstaben kürzen
    53. RangeBereich = Mid(RangeBereich, 2)
    54. Else
    55. ' Startadresse
    56. Wert(1) = Mid(RangeBereich, 1, 2)
    58. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    59. Wert(1) = Val((Asc(Mid(Wert(1), 1, 1)) - 64) * 26) + Val((Asc(Mid(Wert(1), 2, 1)) - 64))
    61. ' den Rangebereich um die Buchstaben kürzen
    62. RangeBereich = Mid(RangeBereich, 3)
    63. End If
    65. ' Jetzt noch die Startzeile ermitteln
    66. Wert(2) = Mid(RangeBereich, 1, InStr(1, RangeBereich, ":") - 1)
    67. RangeBereich = Mid(RangeBereich, InStr(1, RangeBereich, ":") + 1)
    69. ' Prüfen, ob das Ende unter AA liegt oder nicht
    70. If Val(Mid(RangeBereich, 2, 1)) > 0 Then
    71. ' Endadresse
    72. Wert(3) = Mid(RangeBereich, 1, 1)
    74. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    75. Wert(3) = Val(Asc(Mid(Wert(3), 1, 1)) - 64)
    77. ' den Rangebereich um die Buchstaben kürzen und somit die Endzeile erhalten
    78. Wert(4) = Mid(RangeBereich, 2, 100)
    79. Else
    80. ' Endadresse
    81. Wert(3) = Mid(RangeBereich, 1, 2)
    83. ' Jetzt noch die Buchstabenwerte in die Spaltennr. umwandeln
    84. Wert(3) = Val((Asc(Mid(Wert(3), 1, 1)) - 64) * 26) + Val(Asc(Mid(Wert(3), 2, 1)) - 64)
    86. ' den Rangebereich um die Buchstaben kürzen
    87. Wert(4) = Mid(RangeBereich, 3, 100)
    88. End If
    90. ' Nun noch den gewünschten Wert zurückliefern
    91. DatenRange_auswerten = Wert(Rueckgabe)
    92. 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

Facebook
Telefonspende