ich habe schon in einem anderen Forum gefragt und eine Lösung bekommen.
Nun ist diese aber aus Gründen der Performance nicht machbar.
Ich brauche eine Dauerhafte Aktualisierung der Daten, welche schnell von Statten geht.
Eine anderer Lösungsansatz war die Formel:
=WENN(INDEX(Tabelle1!A:A;AGGREGAT(15;6;ZEILE($A$1:$A$6000)/((Tabelle1!$A$1:$A$6000"") *(ISTFEHLER(SUCHEN("asd";Tabelle1!$B$1:$B$6000))))+ZEILE($A1)-1-(ABRUNDEN(ZEILE(A1)/19;0)*19); AUFRUNDEN(ZEILE($A1)/19;0)))="";"";INDEX(Tabelle1!A:A;AGGREGAT(15;6;ZEILE($A$1:$A$6000) /((Tabelle1!$A$1:$A$6000"")*(ISTFEHLER(SUCHEN("asd";Tabelle1!$B$1:$B$6000))))+ZEILE($A1) -1-(ABRUNDEN(ZEILE(A1)/19;0)*19);AUFRUNDEN(ZEILE($A1)/19;0))))
Dies ist aber auch um einiges zu langsam.
In der nicht anonymisierten tabelle habe ich Momentan um die 3000 Zeilen.
In einem Monat dürften das 30000 sein.
Ich brauche wirklich eine Lösung, welche schnell und effizient ist.
Bei einer manuellen EIngabe sowie copy paste, muss das Ergebnis der Änderung auf den Blättern 2 und 3 unmittelbar vergfügbar sein.
Falls jemand eine Idee hat, bitte bitte melden. Auch wenn dafür andere Programme benötigt werden würden.
Ich muss das irgendwie bewerkstelligen.
https://www.herber.de/bbs/user/109101.xlsx
Momentan wird dies verwendet:
Option Explicit
Sub kopieren()
ScreenUpdating = False
EnableEvents = False
Dim x As Long
Sheets("Tabelle2").Cells.ClearContents
Sheets("Tabelle3").Cells.ClearContents
For x = 1 To LetzteZeile(Sheets("Tabelle1"))
If Sheets("Tabelle1").Range("A" & x).Text "" And Not Sheets("Tabelle1").Range("B" & x).Text Like "*asd*" Then
Sheets("Tabelle1").Range("A" & x & ":E" & x + 18).Copy _
Sheets("Tabelle2").Range("A" & LetzteZeile(Sheets("Tabelle2")) + 1)
x = x + 18
Else
Sheets("Tabelle1").Range("A" & x & ":E" & x).Copy _
Sheets("Tabelle3").Range("A" & LetzteZeile(Sheets("Tabelle3")) + 1)
End If
Next x
ScreenUpdating = True
EnableEvents = True
MsgBox "Fertig!"
End Sub
Public Function LetzteZeile(wks As Worksheet) As Long
On Error Resume Next
LetzteZeile = wks.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious). _
Row
If Err Then
LetzteZeile = 0
End If
On Error GoTo 0
End Function