nicht ohne viel "Wenn und Aber" ... :)
15.08.2016 13:40:31
gjunge
ich vergleiche zwei Tabellen und führe diese dann mittels VBA zusammen. Das Ergebnis ist noch nicht ganz, was ich mir wünsche. Vielleicht kann mir hier jemand weiterhelfen?
Ich würde gern noch Spalte I abfragen. D.h. wenn in meinem Vergleich der Tabellen die Zellfarbe der Spalte A-I ohne Füllung und in Spalte I kein Ergebnis eingetragen ist und dabei der Inhalt der Spalten A-H in anderen Zeilen absolut identisch ist und die Zellfarbe = gelb und ein Ergebnis drinsteht, dann soll die Zeile ohne ein Ergebnis in I gelöscht werden.
Ich weiß, dass ich es mit einer Bedingten Formatierung mit Formel lösen kann. Leider geht das aufgrund der riesigen Datenmengen nicht unzusetzen.
Ich hoffe, dass meine Bsp. Datei aussagen kann, was ich möchte. Der VBA Code für diesen Teil sieht so aus:
Sub merge()
Dim wks As Worksheet
Dim rngA As Range, rngB As Range
Dim iRow As Integer, iCounter As Integer, iCol As Integer
Application.ScreenUpdating = False
Set rngA = Worksheets("download1507").Range("A1").CurrentRegion
Set rngB = Worksheets("download2207").Range("A1").CurrentRegion
Set wks = Worksheets("Daten")
iCol = rngA.Columns.Count
If rngB.Columns.Count > iCol Then
iCol = rngB.Columns.Count
End If
For iCounter = 1 To iCol
Next iCounter
rngA.Range("A1").CurrentRegion.Copy wks.Range("A2")
iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
rngB.Range("A1").CurrentRegion.Copy wks.Cells(iRow, 1)
wks.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wks.Cells(1, wks.UsedRange.Columns.Count + 1), _
Unique:=True
wks.Range(wks.Cells(1, 1), wks.Cells(1, iCol)). _
EntireColumn.Delete
wks.Columns.AutoFit
End Sub
Sub UpdateResults()
Dim lngLetzte As Long
Dim lngZeile As Long
Application.ScreenUpdating = False
lngLetzte = IIf(IsEmpty(Range("I65536")), Range("I65536").End(xlUp).Row + 1, 65536)
For lngZeile = lngLetzte To 1 Step -1
If Cells(lngZeile, 9) "" Then
Cells(lngZeile, 9).EntireRow.Interior.ColorIndex = 6
End If
Next
Application.ScreenUpdating = True
End Sub
Für Hilfe bin ich dankbar