VBA
27.04.2018 13:06:21
UweD
Hallo
hier ein VBA Lösung
Sub Abgleich()
Dim TB1, TB2, TB3, i As Double, j As Integer, LR1 As Double, LC1 As Integer
Dim Zeile As Double, Spalte As Integer
Const Rot = -16776961
Const Gruen = -11489280
Const strLeer = "(Leer)"
Set TB1 = Sheets("Liste")
Set TB2 = Sheets("Basis_Ausstattung_A")
Set TB3 = Sheets("Sonder_Ausstattung_B")
With TB1
LR1 = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
LC1 = .Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten Blattes
With .Range(.Cells(2, 6), .Cells(LR1, LC1))
.Font.Color = Gruen
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2," & TB2.Name & "!C2:C21,COLUMN(RC[-3]),0),"""")" 'Sverweis auf TB2
.Value = .Value 'Formel in Werte tauschen
End With
For j = 6 To LC1
For i = 2 To LR1
If .Cells(i, j) <> strLeer And .Cells(i, j) <> "" Then
If WorksheetFunction.CountIf(TB3.Columns(4), .Cells(i, 4)) > 0 Then ' ist Nr überhaupt da
Zeile = WorksheetFunction.Match(.Cells(i, 4), TB3.Columns(4), 0) ' in welcher Zeile
If WorksheetFunction.CountIf(TB3.Rows(Zeile), Left(.Cells(i, j), 2) & "*") > 0 Then ' ist links2 in Zeile
Spalte = WorksheetFunction.Match(Left(.Cells(i, j), 2) & "*", TB3.Rows(Zeile), 0) ' in welcher Spalte
With .Cells(i, j)
.Value = TB3.Cells(Zeile, Spalte) 'Wert tauschen
.Font.Color = Rot ' färben
End With
End If
End If
Else
.Cells(i, j).Font.ColorIndex = xlAutomatic
End If
Next i
Next j
End With
End Sub
LG UweD