automatischer Übertrag von Tabelle 1 nach 2

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Alex
Im Anhang ein Gegenvorschlag.
https://www.herber.de/bbs/user/105041.xls
Das Blatt "Best Price" aktualisiert sich mittels folgendem Makro automatisch.

Private Sub Worksheet_Activate()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, letzteZeile As Long
' Blattnamen anpassen
Set WS1 = Worksheets("Blatt2")
Set WS2 = Worksheets("Best Price")
' Prüfen ob neue Objekte vorhanden sind
For iZeile = 3 To WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(WS2.Columns(1), WS1.Cells(iZeile, 1)) = 0 Then
letzteZeile = WS2.Cells(WS2.Rows.Count, 1).End(xlUp).Row + 1
WS2.Cells(letzteZeile, 1) = WS1.Cells(iZeile, 1)
WS2.Cells(letzteZeile, 2).Formula = "=SUMIF(" & WS1.Name & "!A:A,A" & letzteZeile & ","  _
& WS1.Name & "!F:F)"
WS2.Cells(letzteZeile, 3).Formula = "=SUMIF(" & WS1.Name & "!A:A,A" & letzteZeile & ","  _
& WS1.Name & "!G:G)"
WS2.Cells(letzteZeile, 4).Formula = "=C" & letzteZeile & "/SUM(C:C)"
WS2.Cells(letzteZeile, 5).FormulaArray = "=MIN(IF(" & WS1.Name & "!A$3:A$1000=A" &  _
letzteZeile & "," & WS1.Name & "!G$3:G$1000))"
WS2.Cells(letzteZeile, 6).FormulaArray = "=MAX(IF(" & WS1.Name & "!A$3:A$1000=A" &  _
letzteZeile & "," & WS1.Name & "!G$3:G$1000))"
End If
Next iZeile
' Wegfallende Objekte löschen
For iZeile = WS2.Cells(WS2.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) = 0 Then _
WS2.Rows(iZeile).Delete
Next iZeile
End Sub

Im Blatt "Best Price" kannst du angeben, wenn du einen günstigeren Preis findest. Dieser wird dann in Blatt2 übernommen und die Zeile rot markiert.
cu
Chris

Hi Alex
Blatt "Best Price" ist nichts anderes wie deine Pivot Auswertung (Spalte Min/Max kannst auch löschen). Einfach nicht mit Pivot sondern mit Formeln und VBA. Daneben trägst du deinen neuen Preis ein und der wird wie gewünscht übernommen.
Wenn du dies in einer Pivot machst, hast du ein Problem mit der Aktualisierung (Zeilen können sich verschieben) und der Bezug zurück auf Blatt2 musst jedes mal neu erstellen. Eine Durchmischung von Daten und Auswertung ist problematisch. Zudem hast du auf der Pivot eine Summenbetrachtung, was sich dann mit Stückpreisen durchmischt.
Blatt2 Spalte H kannst auch wie folgt ändern:
=WENN(SVERWEIS(A3;'Best Price'!A:G;7;FALSCH)=0;G3;SVERWEIS(A3;'Best Price'!A:G;7;FALSCH))
Und wenn es unbedingt sein muss, kannst du Spalte G auch mit Spalte H überschreiben
Columns(7) = Columns(8).Value
cu
Chris

Sub t() Dim WS1 As Worksheet, WS2 As Worksheet Dim iZeile As Long, tempZeile As Long, tempRng As Range Dim iiZeile As Long, letzteZeile As Long Set WS1 = Worksheets("Blatt1") Set WS2 = Worksheets("Blatt2") letzteZeile = WS2.Cells(WS2.Rows.Count, 4).End(xlUp).Row For iZeile = 7 To WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row - 1 If WS1.Cells(iZeile, 5) "" Then For iiZeile = 3 To letzteZeile Set tempRng = WS2.Range(WS2.Cells(iiZeile, 4), WS2.Cells(letzteZeile, 4)) If WorksheetFunction.CountIf(tempRng, WS1.Cells(iZeile, 1)) = 0 Then Exit For Else tempZeile = Application.Match(WS1.Cells(iZeile, 1), tempRng, 0) + iiZeile - 1 WS2.Cells(tempZeile, 6) = WS1.Cells(iZeile, 5) iiZeile = tempZeile + 1 End If Next iiZeile End If Next iZeile End Sub

Beliebteste Forumthreads (12 Monate)

automatischer Übertrag von Tabelle 1 nach 2

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread