VBA u.a. dynamischer Bereich

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
ich übernehme jetzt Blatt für Blatt in eine neue Arbeitsmappe, um zu testen, wo der Fehler liegt. Ist sehr aufwendig, da ich die Formeln anpassen muss. Werde mich dann morgen dazu melden (wobei, bis jetzt passt es - verrückt)
1.
Aber, kann dennoch jemand, oder Ralf? schauen, wie ich im VBA die Tabelle dynamisch anspreche? In der Testdatei ist sie noch nicht dyn. gesetzt, würde sie dan "dyn_daten" nennen.
2.
Ist die Artikel-Nr. bereits im Reg. Daten vohanden, dann die Bezeichnung in C nicht übertragen aber Nachfolger in B und Preis in H überschreiben mit den Daten aus der Preisliste wobei der Preis durch 100 dividiert werden muss. In der Preisliste gilt der Preis pro 100.
Freue mich natürlich über jede weitere Unterstützung und sage im voraus schon einmal DANKE.
Viele Grüße
Claudia

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

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(3).Value = TB3.Cells(i, 2).Value '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(2) = TB3.Cells(i, 3) '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

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread