Vergleich 2er Mappen

Hi,
habe mich schon etwas durch das breite angebot an hilfen durchgearbeitet, aber finde mich damit nicht ganz so zurecht.
Mein Probelm!
ich habe 2 Mappen (jeweils eine pro datei - also 2 dateien) an Testverfahren, die auf unterschiede untersucht werden sollen!
Eine mappe enthaellt informationen ueber das produkt, was unintressant ist. Dann jeweils ueberschriften mit den einzelnen Tests mit unterpunkte. Zum einen soll vergleichen werden ob bei beiden Mappen die gleichen tests vorhanden sind, wenn ja dann muessen die einzelnen unterpunkte uebreprueft werden auf gleichheit. Taucht zB in beiden der Test auf, aber in dem einen bzw dem anderen mehrere / wenigere unterpunkte, muesste das farblich festgemacht werden.
Das weitere Problem dabei ist, das die anordnung der tests nicht immer gleich ausfaellt. Die Unterpunktliste ist auch nciht immer lgeich lang.
kleines beispiel:
Mappe1:
test for HDF
+HB22/33
+HV38/11
..
..
..
Mappe2:
test for HDF
+HB22/33
+HB37/05
+HV38/18
+HV38/11
..
..
in mappe 2 tauchen die selben unterpunkte auf wie in mappe 1, zusaetzlich aber noch 2 weitere unterpunkte, die kenntlich gemacht werden muessten.
Ich hoffe ich konnte mein Problem halbwegs erkenntlich machen.
Vielen dank fuer anregungen und ueberlegungen!!!
ich weiss das zu schaetzen.
euer Hans Peters

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hans,
wie folgt, wenn beide Arbeitsmappen geöffnet sind:


Sub VergleichenMarkieren()
Dim rngA As Range, rngB As Range, rng As Range, rngFound As Range, _
rngTarget As Range, rngPart As Range
Dim iCounter As Integer
Dim sValue As String
For iCounter = 1 To 2
If iCounter = 1 Then
Set rngA = Workbooks("Test1.xls").Worksheets(1).UsedRange
Set rngB = Workbooks("Test2.xls").Worksheets(1).UsedRange
Else
Set rngA = Workbooks("Test2.xls").Worksheets(1).UsedRange
Set rngB = Workbooks("Test1.xls").Worksheets(1).UsedRange
End If
rngA.Interior.ColorIndex = xlColorIndexNone
For Each rng In rngA.Cells
If InStr(rng.Value, "+") = False And InStr(rng.Offset(1, 0).Value, "+") Then
Set rngFound = rngB.Find(rng.Value, LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
rng.Interior.ColorIndex = 3
Else
Set rngTarget = rngFound.Offset(1, 0)
sValue = rngTarget.Value
Do While InStr(sValue, "+")
Set rngTarget = Union(rngTarget, rngTarget.Offset(1, 0))
sValue = rngTarget.Cells(rngTarget.Cells.Count).Offset(1, 0).Value
Loop
Set rng = rng.Offset(1, 0)
Do While InStr(rng.Value, "+")
Set rngPart = rngTarget.Find(rng.Value, LookIn:=xlValues, Lookat:=xlWhole)
If rngPart Is Nothing Then
rng.Interior.ColorIndex = 6
End If
Set rng = rng.Offset(1, 0)
Loop
End If
End If
Next rng
Next iCounter
End Sub

Ich hab allerdings den Verdacht, dass es da noch ein paar Eventualitäten gibt.
Gruss hans
---
Versuch und Irrtum war gestern

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread