Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1672to1676
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sverweis durch VBA ablösen

Sverweis durch VBA ablösen
06.02.2019 10:17:55
Junior
Hallo,
ich habe folgenden SVerweis in Spalte AS der Tabelle1:
=WENN(AR3"--";(SVERWEIS(AP3&AQ3;Tabelle99!A:E;5;FALSCH));"")
Dieser bewirkt, dass bei der Änderung von AR3 (Standartwert wird durch eine Verkettung der Zellen AP3&AQ3 erzeugt und ist “- -“ ) der SVerweis ausgeführt wird und die Zellenkombination aus AP3&AQ3 in der Tabelle99 gesucht wird.
Da sich die Tabelle über 10.000 Zeilen erstreckt, habe ich das Problem einer sehr langen Laufzeit (beim zwischenspeichern, beim filtern usw., da sich der SVerweis dabei immer aktualisieren muss (was auch notwendig ist).
Gerne würde ich den SVerweis durch eine VBA Funktion ablösen, die automatisiert gestartet wird, wenn sich der Inhalt von AR3 ändern. Die Änderung von AR3 erfolgt durch 2 Einzelschritte: Erst wird AP3 geändert, dann AQ3. Beides mal muss der SVerweis gestartet werden.
Hat jemand eine Lösung?
Danke & Gruß
Junior

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sverweis durch VBA ablösen
06.02.2019 10:34:51
Rainer
Hallo Junior,
Du tippst also nacheinander in AP3 und AQ3 Werte ein.
Was bringt es dann, denn SVERWEIS zu starten, wenn nur AP3 geändert wird?
Ist es evtl. bei geringen VBA Kenntnissen einfacher, die automatische Neuberechnung zu deaktivieren und manuell zu starten, wenn neue Eingaben gemacht wurden?
Oder probiere mal, den Svwerweis durch die Kombo von VERGLEICH und INDEX zu ersetzen.
Vielleicht hast du auch eine Beispieldatei?
Gruß,
Rainer
AW: Sverweis durch VBA ablösen
06.02.2019 10:42:00
UweD
Hallo
VBA unter Verwendung der Formel...
- Rechtsklick auf den Tabellenblattreiter von Tabelle1
- Code anzeigen
- den Code rechts reinkopieren
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    If Target.Count > 1 Then
        MsgBox " nur einzeln ändern"
        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
        Exit Sub
    End If
    If Target.Row > 1 Then 'Wegen Überschrift 
        If Not Intersect(Range("AQ:AR"), Target) Is Nothing Then
            Application.EnableEvents = False
            With Cells(Target.Row, "AS")
                .FormulaR1C1 = _
                    "=IF(RC[-1]<>""--"",(VLOOKUP(RC[-3]&RC[-2],Tabelle99!C[-44]:C[-40],5,FALSE)),"""")"
                .Value = .Value
            End With
            Application.EnableEvents = True
        End If
    End If
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
Anzeige
AW: Sverweis durch VBA ablösen
06.02.2019 12:09:58
Junior
Hallo Uwe,
das funktioniert gut. Jetzt ist das Problem, dass sich AR3 ändern kann, wenn ich den Wert in AP3 oder AQ3 ändere. Da AR3 aber bereits "- -" ist, erfolgt keine Aktualisierung von AS3. Das wäre ein Fehler.
Also im Prinzip muss deine Logik greifen, wenn sich AR3 ändert. Egal von was auf was. war mir vorher nicht so bewusst. Sorry.
AW: Sverweis durch VBA ablösen
06.02.2019 13:50:20
UweD
Hallo
Verstehe zwar nicht, da die Formeländerung in AR zuerst ausgeführt wird, bevor das Makro läuft.
Evtl liegt es aber auch daran, dass ich AQ:AR anstelle von AP:AQ eingetragen hatte.
Ändere das mal zuerst,
wenn das nicht hilft, dann das zusätzlich Die Zeile mit dem Aktualisieren der Zelle
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    If Target.Count > 1 Then
        MsgBox " nur einzeln ändern"
        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
        Exit Sub
    End If
    If Target.Row > 1 Then 'Wegen Überschrift 
        If Not Intersect(Range("AP:AQ"), Target) Is Nothing Then
            Application.EnableEvents = False
            With Cells(Target.Row, "AS")
                .Offset(-1, 0).Formula = .Offset(-1, 0).Formula ' AR aktualisieren 
                
                .FormulaR1C1 = _
                    "=IF(RC[-1]<>""--"",(VLOOKUP(RC[-3]&RC[-2],Tabelle99!C1:C5,5,FALSE)),"""")"
                .Value = .Value
            End With
            Application.EnableEvents = True
        End If
    End If
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige