AW: VBA u.a. dynamischer Bereich
27.12.2021 01:50:11
ralf_b
hier eine Variante mit der "dynamischen Tabelle"
Ich habe die Programmlogik etwas umgestellt und, aus meiner Sicht, vereinfacht.
Ich hoffe deine Anforderungen richtig verstanden zu haben.
Sub DatenabgleichDynTab()
Dim TB3 As Worksheet
Dim i As Long
Dim result, ArtNr
Dim objLstRows As ListRows 'liste aller Zeilen in dyn Tab
Dim obLstRow As ListRow ' einzelne Zeile in dyn Tab
Dim objLst As ListObject ' dyn Tab objekt
Set TB3 = Worksheets("Preisliste")
Set objLst = Worksheets("daten").ListObjects("dyn_daten")
Set objLstRows = objLst.ListRows
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To TB3.Cells(Rows.Count, 1).End(xlUp).Row 'preisliste
ArtNr = TB3.Cells(i, 1)
result = Application.Match(ArtNr, objLst.ListColumns(1).DataBodyRange, 0)
If IsError(result) Then
'nicht gefunden
Set obLstRow = objLstRows.Add
With obLstRow.Range
.Cells(1) = ArtNr
.Cells(1).Interior.Color = RGB(169, 208, 142) 'helleres Grün um schwarze Schriftzeichen besser lesen zu können 'vbGreen
.Cells(2) = TB3.Cells(i, 3) 'Bezeichnung
End With
Else
'wenn gefunden Zeilenobject setzen
Set obLstRow = objLstRows(result)
With obLstRow.Range
Select Case .Cells(2).Value
Case "ersatzlos", "Ersatzlos", "Kein Nachfolger", Empty
Case Else: .Cells(1).Interior.Color = vbYellow
End Select
End With
End If
obLstRow.Range.Cells(3) = TB3.Cells(i, 2) 'Nachfolger
obLstRow.Range.Cells(8) = TB3.Cells(i, 4) / 100 'Preis
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set objLstRows = Nothing
Set obLstRow = Nothing
Set objLst = Nothing
End Sub