Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1304to1308
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 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

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

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

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

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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige