Mit Makro Werte in anderer Tabelle updaten

Hallo Excel-Profis,
ich komme alleine nicht weiter bzw. finde den Anfang nicht.
Ich habe eine Auswertung mit Rechnungen in der bei Zahlungseingang dann in Tabelle1 etwas eingegeben wird.
Danach wird per Makro dieser Datensatz in eine Tabelle "Liste" übertragen.
Im Blatt "Liste" stehen die ganzen einzelnen Datensätze.
Bei diesen Datensätzen soll jetzt in Spalte AA "bez" eingetragen werden.
Aber nur für die Rechnung die jetzt als bezahlt markiert wird- die Rechnungsnummer ist im Blatt "Liste" in Spalte D.
D.h. das Makro müßte wie folgt ablaufen:
1. in "Tabelle1" steht in Zelle AA1 die Rechnungsnummer. z.B. 100
2. Das Makro wechselt in das Blatt "Liste" durchsucht die Spalte D nach der 100 und schreibt bei denen Sätzen die 100 haben ein "bez" in Spalte AA
Wenn es geht sollte man sicherheitshalber auch 2 Kriterien angeben können z.B. Rechnung 100 und Position (Spalte AB im Blatt "Tabelle1"; Spalte E im Blatt "Liste).
Da ja immer alle Zeilen im Blatt Liste durchlaufen werden müssen, muß das halbwegs schnell sein - also wohl erst auf Nichtübereinstimmung prüfen und dann nächster Satz?
Vielen Dank im voraus für Eure Hilfe.
Viele Grüße Lutz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Günther,
vielen lieben Dank.
Funktioniert gut! Leider habe ich ziemlich viele Datensätze und wenn man es mal auf 65000 Datensätze im Blatt Liste füllt, dauert es ziemlich lange.
Ich habe es schon mal etwas gentunt (siehe appliation...):


Sub Bezahlt_markieren2()
Dim RechnungsFeld, Listenfeld As Object
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
ActiveWorkbook.Sheets("Liste").Activate
ActiveWorkbook.Sheets("Liste").Activate
For Each RechnungsFeld In Worksheets("Tabelle1").Range("AA1:AA" & Worksheets("Tabelle1").Cells. _
SpecialCells(xlCellTypeLastCell).Row)
For Each Listenfeld In ActiveSheet.Range("D2:D" & ActiveSheet.Cells.SpecialCells( _
xlCellTypeLastCell).Row)
If Listenfeld.Text = RechnungsFeld.Text Then
If Listenfeld.Offset(0, 1) = RechnungsFeld.Offset(0, 1) Then
ActiveSheet.Range("AA" & Listenfeld.Row) = "bez"
End If
End If
Next Listenfeld
Next RechnungsFeld
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
End Sub

Ich habe leider auch nicht so viel Plan, ich denke, das mit dem select bei der Tabelle frißt wohl Leistung?!
Vielleicht sieht sich das noch mal ein "Performance-Profi" an?
Vielleicht ist es schneller beide Bedingungen in eine Zeile zu packen?
Ich habe irgednwo auch mal gelesen, dass es schneller ist, wenn man erst das abfragt was meistens nicht zutrifft - also das der Suchbegriff dem Inhalt der Zelle ist?
In jedem Fall schon mal vielen lieben Dank für Deine Mühe
Viele Grüße Lutz

Option Explicit Sub Bezahlt_markieren2() Dim ZeiL As Long Call Langsam(False) Const Formel As String = "=IF(AND(Tabelle1!AA1=D1,Tabelle1!AB1=E1),""bez"","""")" With ActiveWorkbook.Worksheets("Liste") ZeiL = .Cells(.Rows.Count, 4).End(xlUp).Row .Range("AA1:AA" & ZeiL).Formula = Formel .Range("AA1:AA" & ZeiL).Value = .Range("AA1:AA" & ZeiL).Value End With Call Langsam(True) End Sub Sub Langsam(ByVal EinAus As Boolean) With Application .ScreenUpdating = EinAus .EnableEvents = EinAus .DisplayAlerts = EinAus .Calculation = IIf(EinAus, xlManual, xlAutomatic) End With End Sub

Sub Bezahlt_markieren4() 'Für kleiner Datenmengen, Sortierung bleibt erhalten Dim ZeiL As Long Const Formel As String = "=If(E1=VLookUp(d1,Tabelle1!AA:AB,2,0),""bez"","""")" With ActiveWorkbook.Worksheets("Liste") ZeiL = .Cells(.Rows.Count, 4).End(xlUp).Row With .Range("AA1:AA" & ZeiL) .Formula = Formel .Value = .Value On Error Resume Next .SpecialCells(xlCellTypeConstants, 16).ClearContents On Error GoTo 0 End With End With End Sub Sub Bezahlt_markieren5() 'für Grössere Datenmengen, Tabelle1 Spalte AA:AB wird für schneller Verarbeitung sortiert Dim ZeiL As Long Const Formel As String = "=IF(D1=Vlookup(D1,Tabelle1!AA:AA,1,1),If(E1=VLookUp(d1,Tabelle1!AA: _ AB,2,1),""bez"",""""),"""")" Sheets("Tabelle1").Range("AA:AB").Sort Key1:=Sheets("Tabelle1").Range("AA1"), order1:= _ xlAscending, Header:=xlNo With ActiveWorkbook.Worksheets("Liste") ZeiL = .Cells(.Rows.Count, 4).End(xlUp).Row With .Range("AA1:AA" & ZeiL) .Formula = Formel .Value = .Value End With End With End Sub

Beliebteste Forumthreads (12 Monate)

Mit Makro Werte in anderer Tabelle updaten

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mit Makro Werte in anderer Tabelle updaten

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread