Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: SVERWEIS per VBA

SVERWEIS per VBA
20.03.2013 20:09:11
Selma
Hallo Leute,
ich möchte für die aktuelle Spalte nur für die Zellen die mit dem Zahl beginnen, folgendes (für den Bereich ab Zeile A2 bis letzte benutze Zelle der Spalte A) per VBA erreichen:
Der Zellwert soll im Blatt "Daten" in Spalte A gesucht werden und wenn es gefunden wird, dann soll der Zellwert mit dem Wert der in Spalte B des Blattes "Daten" steht ersetzt werden.
Im Blatt "Daten" stehen in Spalte A nur die Zahlen von A2:A8000 und in der Spalte B die Nachnamen.
Ich weiß, das es mit den Formel SVERWEIS auch gehen würde, aber ich müßte sehr viele Hilfspalten anlegen. Liebe wäre es mir VBA und ich könnte es dann auf ca. 25 Spalten anwenden, die ich abarbeiten muss...
Besten Dank im Voraus!
Gruß,
Selma

Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: SVERWEIS per VBA
20.03.2013 20:14:22
Matze
Hallo Selma,
ich frag mich gerade echt, ob ich "Hallo's" habe, ist jetzt das dritte Problem mit Sverweis.
Mach bitte eine Musterdatei wie der Aufbau der Mappe ist.
und wie die Lösung darin aussehen soll.
Matze

Tipp: SVerweis mit Makrorekorder aufzeichen
20.03.2013 20:25:53
Andy
Hallo Selma,
hast Du schon mal probiert deinen SVerweis mit dem Makrorekorder aufzuzeichnen?
Ich hatte mal ein ähnliches Problem und konnte es mit dem Makrorekorder lösen. Evtl. mußt Du dort noch eine kleine Codesäuberung durchführen.
Gruß Andy

Anzeige
AW: Tipp: SVerweis mit Makrorekorder aufzeichen
20.03.2013 23:22:29
Selma
Hallo Zusammen,
anbei eine Beispieldatei. https://www.herber.de/bbs/user/84473.xlsx
Ich möchte im aktivem Blatt z.B. Tabelle1 eine Zelle in eine Spalte anklicken und das Makro ausführen, dann sollen in diese Spalte (ab Zeile 2 bis letzte benutzte Zelle der Spalte A) alle Zellwerte die mit Zahl beginnen im Blatt "Daten" (ab Zeile 2 bis 8000) in Spalte A gesucht werden, wenn der Wert gefunden wird, dann Wert aus der Spalte B (Städte) nehmen und in die Zelle im "Startblatt" sprich "Tabelle1" eintragen / durch Zahl ersetzen.
Danke!
Gruß,
Selma

Anzeige
AW: Tipp: SVerweis mit Makrorekorder aufzeichen
21.03.2013 00:12:47
daniel
Hi
probier mal diesen Code, passend für deine Beispieldatei:
Sub test()
Dim sp1 As Long
Dim sp2 As Long
Dim ze1 As Long
Dim ze2 As Long
Dim Fo As String
ze1 = 2
ze2 = Cells(Rows.Count, 1).End(xlUp).Row
sp1 = ActiveCell.Column
sp2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column + 1
With Sheets("Daten").Range("A:B")
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End With
Fo = "=IF(ISNUMBER(RCx),IF(VLOOKUP(RCx,Daten!xxx,1,1)=RCx,VLOOKUP(RCx,Daten!xxx,2,1),RCx),RCx)"
Fo = Replace(Fo, "RCx", "RC" & sp1)
Fo = Replace(Fo, "xxx", Sheets("Daten").Cells(1, 1).CurrentRegion.Address(1, 1, xlR1C1))
With Range(Cells(ze1, sp2), Cells(ze2, sp2))
.FormulaR1C1 = Fo
.Copy
Cells(ze1, sp1).PasteSpecial xlPasteValues
.ClearContents
End With
Application.CutCopyMode = False
End Sub
Gruß Daniel

Anzeige
AW: SVERWEIS per VBA = .FIND+OFFSET
20.03.2013 23:11:36
Daniel
Hi
wenn du den SVerweis per VBA ausführen willst, dann ist zumindest für den SVerweis mit 4.Parameter = FALSCH (0) die Kombination aus .FIND + OFFSET die einfachste Ersatzmöglichkeit
=SVerweis(A2;Daten!A:B;2;0) 

wird zu
= Sheets("Daten").Range("A:A").Find(what:=Range("A2").Value, Lookat:=xlwhole, LookIn:=xlvalues) .Offset(0, 1) .Value
alternativ kannst du auch mit Worksheetfunctions arbeiten:
=Worksheetfunction.VLookUp(Range("A2").Value, Sheets("Daten").Range("A:B"), 2, 0)
bei der Datenmenge (8000 Zeilen) scheitn es mir aber angebracht, die Quelldatei zu sortiern um die schnellere SVerweisvariante mit 4. Parameter = WAHR oder 1 verwenden zu können.
diese kannst du allerdings nur per Formel oder die Worksheetfunction.VLookUp verwenden.
allerdings ist meine Erfahrung, daß die Methode die Formeln direkt in die Zellen zu schreiben wesentlich schneller ist, weil man in VBA doch dazu neigt, die Zellen einzeln in einer Schleife zu bearbeiten, was sehr viel Zeit kostet.
Beim Arbeiten mit Formeln per VBA kann ich oft die Formel in alle Zellen der Spalte gleichzeitig schreiben, was viel schneller geht, weswegen sich man auch von ein paar Hilfsspalten nicht abschrecken lassen sollte, den Spalten hab ich seit Office 2007 genügend zur Verfügung.
außerdem kann Excel bei der Berechung von Formeln die Mehrfach-Kerne deines Rechners ausnutzen (sofern er über diese Verfügt), bei VBA-Makros geht das meines wissens nach noch nicht.
Gruß Daniel

Anzeige
VBA-Lösungen ohne SVERWEIS, mit Array
21.03.2013 07:41:13
Erich
Hi Selma,
probier auch mal diese beiden:

Sub test3()
Dim sp1 As Long, sp2 As Long, ze1 As Long, ze2 As Long
Dim arrDa, arrDb, arrW, zz As Long, varF
ze1 = 2
ze2 = Cells(Rows.Count, 1).End(xlUp).Row
sp1 = ActiveCell.Column
sp2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column + 1
With Sheets("Daten")
arrDa = .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
arrDb = .Cells(2, 2).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
End With
With ActiveSheet
arrW = .Cells(2, sp1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
For zz = 1 To UBound(arrW)
If Application.IsNumber(arrW(zz, 1)) Then
varF = Application.Match(arrW(zz, 1), arrDa, 0)
If IsNumeric(varF) Then arrW(zz, 1) = arrDb(varF, 1)
End If
Next zz
.Cells(2, sp2).Resize(UBound(arrW)) = arrW
End With
End Sub
Sub test2()
Dim sp1 As Long, sp2 As Long, ze1 As Long, ze2 As Long
Dim arrD, arrW, zz As Long, dd As Long
ze1 = 2
ze2 = Cells(Rows.Count, 1).End(xlUp).Row
sp1 = ActiveCell.Column
sp2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column + 1
With Sheets("Daten")
arrD = .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 2)
End With
With ActiveSheet
arrW = .Cells(2, sp1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
For zz = 1 To UBound(arrW)
If Application.IsNumber(arrW(zz, 1)) Then
For dd = 1 To UBound(arrD)
If arrW(zz, 1) = arrD(dd, 1) Then
arrW(zz, 1) = arrD(dd, 2)
Exit For
End If
Next dd
End If
Next zz
.Cells(2, sp2).Resize(UBound(arrW)) = arrW
End With
End Sub
Darin werden in einem Rutsch alle Quelldaten in Arrays eingelesen, im Array arrW ersetzt,
und dann - auch wieder in einem Rutsch - die Ergebnisse ausgegeben.
@Daniel: SVERWEIS mit WAHR/1 als 4. Parameter findet auch "ungefähre" Entsprechungen.
Das ist hier sicher nicht erwünscht. Man müsste zumindest noch auf Gleichheit des Treffers prüfen.
Zwischen (VBA-)Formellösung und der VBA-Bearbeitung der einzelnen Zellen gibt es andere, schnellere Möglichkeiten.
In einem Array arbeitet VBA sehr flott. Wenn die Ein- und Ausgabe der Array in einem Rutsch erfolgt,
geht auch das schnell.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: VBA-Lösungen ohne SVERWEIS, mit Array
21.03.2013 08:40:22
Daniel
HI Erich
dein Einwand, dass der SVerweis mit 4. Paramerter = 0 auch bei nichtaubereinstimmung einen Wert findet, ist natürlich richtig.
Allerdings ist der SVerweis-1 bei der genannten Datenmenge (8000) ca. 100x Schneller als der SVerweis-0, so dass sich die Methode auch bei Prüfung auf Gleichheit mit einem 2. Sverweis-1 immer noch lohnt, dann ist man halt nur noch ca. 50x schneller ;-)
Gruss Daniel

Anzeige
AW: VBA-Lösungen ohne SVERWEIS, mit Array
21.03.2013 11:46:37
Selma
Hallo Daniel, hallo Erich,
@Daniel: Dein Makro funktioniert. Gut wäre es, wenn die Zelle leer ist, das diese ignoriert wird.
Momentan wird eine 0 geschrieben.
@Erich: Deine beide Makros auch funktioniert.
Bei Dir wird werden die Ergebnisse in nächste leere Spalte geschrieben.
Lässt sich es ändern, damit diese direkt in die zu ersetzende Spalte landen?
Grundsätzliches: Die gestern hochgeladene Datei habe ich auf die schnelle zusammengestellt.
In der Originaldatei ist im Blatt "Daten" die gesuchte Spalte in "D" und die Ergebnisse in Spalte "O". Ich habe es versucht im Makro anzupassen, leider komme ich nicht klar.
Wss muss ich bitte anpassen?
Danke und Gruß,
Selma

Anzeige
AW: VBA-Lösungen ohne 0-Werte
21.03.2013 12:05:03
Daniel
Hi Selma
du kannst die Formel so ergänzen:
"=IF(RCx="""","""",IF(ISNUMBER(RCx),IF(VLOOKUP(RCx,Daten!xxx,1,1)=RCx,VLOOKUP(RCx,Daten!xxx,2,1),RCx),RCx))"
oder am Schluss mit Replace die 0-Werte entfernen:
...
Columns(sp1).Replace 0, "", xlwhole
End Sub
Gruß Daniel

Anzeige
VBA geändert
21.03.2013 13:35:54
Erich
Hi Selma,
hier sind die gewünschten Änderungen umgesetzt:

Sub test3()
Dim sp1 As Long, sp2 As Long, ze1 As Long
Dim arrDa, arrDb, arrW, zz As Long, varF
With Sheets("Daten")
arrDa = .Cells(2, 4).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row - 1)   ' Spalte D
arrDb = .Cells(2, 15).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row - 1)  ' Spalte O
End With
With ActiveSheet
ze1 = 2
sp1 = ActiveCell.Column
arrW = .Cells(2, sp1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
For zz = 1 To UBound(arrW)
If Application.IsNumber(arrW(zz, 1)) Then
varF = Application.Match(arrW(zz, 1), arrDa, 0)
If IsNumeric(varF) Then arrW(zz, 1) = arrDb(varF, 1)
End If
Next zz
.Cells(ze1, sp1).Resize(UBound(arrW)) = arrW
End With
End Sub
Sub test2()
Dim sp1 As Long, sp2 As Long, ze1 As Long
Dim arrD, arrW, zz As Long, dd As Long
ze1 = 2
sp1 = ActiveCell.Column
With Sheets("Daten")
arrD = .Cells(2, 4).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row - 1, 12) ' D:O
End With
With ActiveSheet
arrW = .Cells(2, sp1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
For zz = 1 To UBound(arrW)
If Application.IsNumber(arrW(zz, 1)) Then
For dd = 1 To UBound(arrD)
If arrW(zz, 1) = arrD(dd, 1) Then
arrW(zz, 1) = arrD(dd, 12)
Exit For
End If
Next dd
End If
Next zz
.Cells(ze1, sp1).Resize(UBound(arrW)) = arrW
End With
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: VBA geändert
21.03.2013 15:33:56
Selma
VIELEN DANK funktioniert perfekt!
Gruß,
Selma
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige
Anzeige

Infobox / Tutorial

SVERWEIS per VBA – Praktische Anwendung


Schritt-für-Schritt-Anleitung

Um den SVERWEIS in VBA anzuwenden, kannst du folgende Schritte befolgen:

  1. Öffne das Excel-Dokument, in dem du den SVERWEIS per VBA umsetzen möchtest.

  2. Starte den VBA-Editor mit Alt + F11.

  3. Füge ein neues Modul hinzu: Klicke auf „Einfügen“ und wähle „Modul“.

  4. Kopiere und füge den folgenden Code ein:

    Sub SVERWEIS_VBA()
       Dim sp1 As Long, sp2 As Long
       Dim ze1 As Long, ze2 As Long
       Dim arrDa, arrDb, arrW, zz As Long, varF
    
       ze1 = 2
       ze2 = Cells(Rows.Count, 1).End(xlUp).Row
       sp1 = ActiveCell.Column
    
       With Sheets("Daten")
           arrDa = .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1) ' Spalte A
           arrDb = .Cells(2, 2).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1) ' Spalte B
       End With
    
       With ActiveSheet
           arrW = .Cells(ze1, sp1).Resize(ze2 - 1)
           For zz = 1 To UBound(arrW)
               If Application.IsNumber(arrW(zz, 1)) Then
                   varF = Application.Match(arrW(zz, 1), arrDa, 0)
                   If IsNumeric(varF) Then arrW(zz, 1) = arrDb(varF, 1)
               End If
           Next zz
           .Cells(ze1, sp1).Resize(UBound(arrW)) = arrW
       End With
    End Sub
  5. Schließe den VBA-Editor und gehe zurück zu Excel.

  6. Wähle die Zelle aus, in der du beginnen möchtest, und führe das Makro aus.


Häufige Fehler und Lösungen

  • Fehler: "Typen unverträglich"

    • Lösung: Überprüfe, ob die Zellen, die du verwendest, tatsächlich Zahlen enthalten. Der Code läuft nur, wenn es sich um numerische Werte handelt.
  • Fehler: "Keine Übereinstimmung gefunden"

    • Lösung: Stelle sicher, dass die Daten in der „Daten“-Tabelle korrekt sind und keine Leerzeichen enthalten.
  • Fehler: Makro funktioniert nicht wie erwartet

    • Lösung: Achte darauf, dass du die richtige Zelle aktivierst, bevor du das Makro ausführst.

Alternative Methoden

Wenn du den SVERWEIS in VBA vermeiden möchtest, kannst du auch folgende Methoden nutzen:

  • Verwendung von .Find und Offset:

    Dim foundCell As Range
    Set foundCell = Sheets("Daten").Range("A:A").Find(what:=Range("A2").Value, Lookat:=xlWhole)
    If Not foundCell Is Nothing Then
       Range("B2").Value = foundCell.Offset(0, 1).Value
    End If
  • Array-Methoden: Einlesen der Daten in Arrays kann die Performance erheblich steigern, besonders bei größeren Datenmengen.


Praktische Beispiele

Hier ist ein praktisches Beispiel, wie du den SVERWEIS in VBA nutzen kannst, um Namen aus einer Liste zu ersetzen:

Sub ReplaceNames()
    Dim i As Long
    For i = 2 To 8000
        If IsNumeric(Sheets("Tabelle1").Cells(i, 1).Value) Then
            Sheets("Tabelle1").Cells(i, 1).Value = Application.VLookup(Sheets("Tabelle1").Cells(i, 1).Value, Sheets("Daten").Range("A:B"), 2, False)
        End If
    Next i
End Sub

Hierbei wird die erste Spalte in „Tabelle1“ durch den entsprechenden Nachnamen aus dem Blatt „Daten“ ersetzt.


Tipps für Profis

  • Formeln in Zellen schreiben: Statt Werte direkt zu ersetzen, kannst du auch Formeln in die Zellen schreiben. Das ermöglicht dynamische Updates.

    Range("A2:A8000").Formula = "=VLOOKUP(A2, Daten!A:B, 2, FALSE)"
  • Verwendung von Arrays: Nutze Arrays für die Verarbeitung von großen Datenmengen, um die Geschwindigkeit zu erhöhen.

  • Makro aufzeichnen: Du kannst den Makrorekorder verwenden, um dir den Code für deine spezifische Anwendung zu generieren.


FAQ: Häufige Fragen

1. Kann ich den SVERWEIS in VBA auch für nicht-numerische Werte verwenden? Ja, du kannst den SVERWEIS auch auf Textwerte anwenden, indem du die entsprechenden Zellen auswählst.

2. Wie kann ich den SVERWEIS durch ein Makro ersetzen? Indem du die oben beschriebenen VBA-Codes anpasst und das Makro ausführst, kannst du den SVERWEIS in Excel VBA effizient nutzen.

3. Was ist der Vorteil von VBA gegenüber der Verwendung von Formeln? VBA ermöglicht es dir, komplexe Logiken und Automatisierungen zu erstellen, die mit Formeln nicht erreichbar sind. Außerdem kannst du die Verarbeitungsgeschwindigkeit bei großen Datenmengen erheblich steigern.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige