Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

bereiche vergleichen

bereiche vergleichen
22.01.2018 15:00:43
Chris
Hallo Forum,
untenstehenden Makro soll mehrere nicht zusammenhängende Rngbereiche drei verschiedener Sheets vergleichen und wenn eine Übereinstimmung gefunden wurde, den Namen des Sheets ausgeben (auch wenn in zwei oder allen drei Sheets das Gleiche steht sollen alle Sheetnamen ausgegeben werden).
Leider reichen meine VBA-Kenntnisse nicht aus.... Schon mal danke. 

​Sub vergleiche()
Dim zelle, rngber, bereich, rngber1, rngber2, rngber3, rngber4, rngber5, rngber6, rngber7,  _
rngber8, rngber9 As Range
Set rngber1 = Worksheets("Tabelle1").Range("C2:H7")
Set rngber2 = Worksheets("Tabelle1").Range("D11:D13")
Set rngber3 = Worksheets("Tabelle1").Range("G11:H13")
Set rngber4 = Worksheets("Tabelle2").Range("C2:H7")
Set rngber5 = Worksheets("Tabelle2").Range("D11:D13")
Set rngber6 = Worksheets("Tabelle2").Range("G11:H13")
Set rngber7 = Worksheets("Tabelle3").Range("C2:H7")
Set rngber8 = Worksheets("Tabelle3").Range("D11:D13")
Set rngber9 = Worksheets("Tabelle3").Range("G11:H13")
Set rngber = Union(rngber1, rngber2, rngber3, rngber4, rngber5, rngber6, rngber7, rngber8,  _
rngber9)
Set bereich = Union(rngber1, rngber2, rngber3)
For Each zelle In bereich
If WorksheetFunction.CountIf(rngber, zelle) > 0 Then MsgBox "Übereinstimmung gefunden im Blatt " _
_
_
_
& wks.Name
Next
End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bereiche vergleichen
22.01.2018 18:36:25
ChrisL
Hi
Was willst du mit was vergleichen?
Tabelle1 mit Tabelle2 und Tabelle1 mit Tabelle3, aber nicht Tabelle2 mit Tabelle3?
Nicht Tabelle2 zu Tabelle1 (umgekehrte Richtung)?
Und auch nicht innerhalb vom gleichen Blatt?
Ich glaube ZÄHLENWENN() geht nur über einen Bereich und über eine Tabelle und Spalte. Vermutlich eher etwas für Search (ctrl + f).
cu
Chris
AW: bereiche vergleichen
22.01.2018 19:14:29
Chris
Hi .
Vergleichen will ich scheet1 („tabelle1“) mit scheet2 und sheet3.
Hierbei immer der gleiche nicht Zusammenhängende Range .
In einem zweiten Makro sheet 2 mit 1 und drei . Dann noch in einen dritten Makro Sheet 3 mit 1&2.
Alle Sheets befinden sich in ein und derselben arbeitsmappe.
Gruß
Chris
Anzeige
AW: bereiche vergleichen
22.01.2018 19:22:37
ChrisL
Hi
Kleiner Überlegungsfehler meinerseits. Umgekehrte Richtung ist natürlich Quatsch (kann keine neuen Ergebnisse mehr bringen). Willst du den Vergleich von Tabelle2 mit Tabelle3 wirklich in einem separaten Makro?
cu
Chris
AW: bereiche vergleichen
23.01.2018 01:08:27
Chris
Nein, kann auch alles in einem Makro sein ...
AW: bereiche vergleichen
23.01.2018 09:47:15
ChrisL
Hi
Sub t()
Call MatchSpezial(Worksheets("Tabelle1"), Worksheets("Tabelle2"), "C2:H7,D11:D13,G11:H13")
Call MatchSpezial(Worksheets("Tabelle1"), Worksheets("Tabelle3"), "C2:H7,D11:D13,G11:H13")
Call MatchSpezial(Worksheets("Tabelle2"), Worksheets("Tabelle3"), "C2:H7,D11:D13,G11:H13")
End Sub


Private Sub MatchSpezial(WS1 As Worksheet, WS2 As Worksheet, strAddress As String)
Dim rngZelle As Range, arWS1 As Variant, arWS2 As Variant
Dim lngAnzahl As Long, lngCounter1 As Long, lngCounter2 As Long
With WS1.Range(strAddress)
lngAnzahl = .Cells.Count
ReDim arWS1(lngAnzahl - 1, 1)
ReDim arWS2(lngAnzahl - 1, 1)
For Each rngZelle In .Cells
arWS1(lngCounter1, 0) = rngZelle
arWS1(lngCounter1, 1) = rngZelle.Address(0, 0)
arWS2(lngCounter1, 0) = WS2.Range(rngZelle.Address)
arWS2(lngCounter1, 1) = rngZelle.Address(0, 0)
lngCounter1 = lngCounter1 + 1
Next rngZelle
End With
For lngCounter1 = LBound(arWS1) To UBound(arWS1)
For lngCounter2 = LBound(arWS2) To UBound(arWS2)
If arWS1(lngCounter1, 0)  "" And arWS1(lngCounter1, 0) = arWS2(lngCounter2, 0) Then _
MsgBox "Match Wert: '" & arWS1(lngCounter1, 0) & "' in Blatt '" & WS1.Name & "!" & _
arWS1(lngCounter1, 1) & "' und '" & WS2.Name & "!" & arWS1(lngCounter2, 1) & "'"
Next lngCounter2
Next lngCounter1
End Sub
cu
Chris
Anzeige
AW: bereiche vergleichen
23.01.2018 12:18:53
Chris
Hallo Chris,
puh! Danke. Das übersteigt mein VBA-Wissen. Ist es dir möglich mir das Makro (im Detail?) zu erklären?
Des Weiteren: Im Moment ist es so, dass jeder Match-Wert in jeweils einer MSGbox ausgegeben wird und ich das Makro nicht beenden kann und über den STRG+ALT+ENTF Excel zunächst beenden muss.
Geht diese Variante:
Alle Übereinstimmungen in einer einzigen MSG-Box auflisten? (alternativ auch eine einfache Userform...)
Vielen Dank
Chris
AW: bereiche vergleichen
23.01.2018 12:40:56
ChrisL
Hi
Detailliert erklären kann ich es auf die Schnelle nicht, da müsstest du dir erst das Basiswissen aneignen. Alle Daten werden in Array/Datenfelder eingelesen und dann die Array verglichen. 

Sub t()
Dim strMeldung As String
strMeldung = MatchSpezial(Worksheets("Tabelle1"), Worksheets("Tabelle2"), _
"C2:H7,D11:D13,G11:H13", strMeldung)
strMeldung = MatchSpezial(Worksheets("Tabelle1"), Worksheets("Tabelle3"), _
"C2:H7,D11:D13,G11:H13", strMeldung)
strMeldung = MatchSpezial(Worksheets("Tabelle2"), Worksheets("Tabelle3"), _
"C2:H7,D11:D13,G11:H13", strMeldung)
If strMeldung  "" Then MsgBox strMeldung
End Sub

Private Function MatchSpezial(WS1 As Worksheet, WS2 As Worksheet, strAddress As String, _
strMeldung As String) As String
Dim rngZelle As Range, arWS1 As Variant, arWS2 As Variant
Dim lngAnzahl As Long, lngCounter1 As Long, lngCounter2 As Long
With WS1.Range(strAddress)
lngAnzahl = .Cells.Count
ReDim arWS1(lngAnzahl - 1, 1)
ReDim arWS2(lngAnzahl - 1, 1)
For Each rngZelle In .Cells
arWS1(lngCounter1, 0) = rngZelle
arWS1(lngCounter1, 1) = rngZelle.Address(0, 0)
arWS2(lngCounter1, 0) = WS2.Range(rngZelle.Address)
arWS2(lngCounter1, 1) = rngZelle.Address(0, 0)
lngCounter1 = lngCounter1 + 1
Next rngZelle
End With
For lngCounter1 = LBound(arWS1) To UBound(arWS1)
For lngCounter2 = LBound(arWS2) To UBound(arWS2)
If arWS1(lngCounter1, 0)  "" And arWS1(lngCounter1, 0) = arWS2(lngCounter2, 0) Then _
strMeldung = strMeldung & _
"Match Wert: '" & arWS1(lngCounter1, 0) & "' in Blatt '" & WS1.Name & "!" & _
arWS1(lngCounter1, 1) & "' und '" & WS2.Name & "!" & arWS1(lngCounter2, 1) & "'" & _
Chr(10)
Next lngCounter2
Next lngCounter1
MatchSpezial = strMeldung
End Function
cu
Chris
Anzeige
AW: bereiche vergleichen
23.01.2018 13:09:12
Chris
Hi,
danke läuft gut so.
Basiswissen zu welchem Thema und wo ist es so erklärt, dass man es als Laie versteht? Hast du da einen link oder ggfs. Buch?
Gruß
Chris
AW: bereiche vergleichen
23.01.2018 13:34:11
ChrisL
Hi
Ich lese keine Bücher ;)
Aber im Archiv findest du Literaturempfehlungen, die Frage wurde schon öfters gestellt.
Abgesehen von Loops, With-Rahmen, Referenzierung, Datentypen, Funktionen... ist sicher ein Verständnis für Array notwendig.
cu
Chris

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige