Suchschleife mehrmals gleicher Wert

Hallo ihr Lieben,
ich stehe hier langsam am Rande der Verzweiflung.
Versuche seit Tagen mich einzuarbeiten, aber leider sind meine Kenntnisse noch sehr rudimentär. Ich würde mich riesig freuen, wenn mir jemand eine Hilfestellung geben kann.
Ich habe bereits ein Makro im Netz von Klaus Dieter gefunden und es versucht anzupassen. Leider ohne Erfolg. Hier die Problemstellung:
Ich habe 2 Tabellenblätter
in beiden sind ca. 5000 Zeilen (variiert)
und Spalten A:CY gefüllt.
Hier benötige ich ein Makro, was die Spalte H (8) der beiden Tabellen mit einander vergleicht und mir die Veränderungen (komplette Zeile) in einem neuen Tabellenblatt wieder gibt.
Dabei kann es jedoch vorkommen, das der Wert in Spalte H mehrfach vorkommt. (Wertpapiernummer) Das soll er mir bitte auch anzeigen. Also wenn sie 10mal vorkommt, soll er es mir auch 10mal anzeigen.
Ausserdem bekomme ich im letzten Abschnitt,
wo er mir die Veränderungen ausgeben soll immer eine Fehlermeldung.
Für euch ist das wahrscheinlich kein Problem, aber ich bekomme schon graue Haare und einen Bart.....
Vielen Vielen Dank bereits vorab.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim verg1(9000) As String
Dim verg2(9000) As String
Dim merk1(9000) As String
Dim merk2(9000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v, vv As Integer
Dim firstaddress As String
Dim tmpRange As Range
Dim tmpRange1 As Range
z = 2
Do While Worksheets("Vormonat").Cells(z, 8) <> ""
verg1(z) = Worksheets("Vormonat").Cells(z, 8)
z = z + 1 Loop
y = 2
Do While Worksheets("Aktuell").Cells(y, 8) <> ""
verg2(y) = Worksheets("Aktuell").Cells(y, 8)
y = y + 1
Loop
If z >= y Then
For r = 1 To z - 1
For s = 1 To y - 1
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
For To Next Schleife
Next r
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Set tmpRange = Worksheets("Vormonat").Rows(t)
firstaddress = tmpRange.Address
Do
tmpRange.EntireRow.Copy
Worksheets("Hilfstabelle").Cells _
(tt, 1).PasteSpecial Paste:=xlPasteAll
Set tmpRange = Worksheets("Vormonat").Rows(t).FindNext(tmpRange)
Loop While Not tmpRange Is Nothing And tmpRange.Address <> firstaddress '
End If
Next t
Else
For r = 1 To z - 1
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next r
Next s
For v = 1 To s
If merk2(v) <> "ja" Then
vv = vv + 1
Set tmpRange1 = Worksheets("Aktuell").Rows(v)
firstaddress1 = tmpRange1.Address
Do
tmpRange1.EntireRow.Copy
Worksheets("Hilfstabelle").Cells _
(vv, 1).PasteSpecial Paste:=xlPasteAll
Set tmpRange1 = Worksheets("Vormonat").Rows(v).FindNext(tmpRange1)
Loop While Not tmpRange1 Is Nothing And tmpRange1.Address <> firstaddress1
End If
Next v
End If

Beliebteste Forumthreads (12 Monate)

Suchschleife mehrmals gleicher Wert

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread