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

VBA erstellen um einen SVerweiss zu ersetzen

VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 08:52:11
Andy
Hallo Zusammen,
ich habe eine Datei erstellt die eine Liste mit einer anderen Liste vergleicht. Sie soll schauen ob im Sheet "Alte_Daten_Save" Teilenummern identisch sind im Sheet "Neue_Daten_Save" und dann anschliessend alles, was bei einer gleichen Teilenummer, in dieser Zeile von Spalte C bis DA kopieren und zur passenden Teilenummer zuordnen im Sheet "Neue_Daten_Save" und die kopierten Abschnitt einfügen ab Spalte D einfügen.
Jetzt hatte ich es mit einem SVerweiss versucht was auch funktioniert hat, da aber dieses Sheet immer wieder komplett nach diesem Vorgang gelöscht wird ist auch jedes mal der SVerweiss weg und müsste per Macro erneut eingefügt werden und da es doch einige Spalten sind würde mich interessieren ob es entweder einen anderen Ansatz gibt oder einen SVerweiss der nicht nur eine Spalte kopieren kann sondern einen ganzen Bereich, so das ich zB nur sagen muss kopiere bei gleicher Teilenummer den ganzen Bereich C-DA in das andere Sheet von D-DB
Ich habe mal das Problem als Datei angehängt.
https://www.herber.de/bbs/user/107400.xlsx
Vielen Dank für eure HILFE

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 09:06:45
baschti007
Wenn du in Neue Daten Die TeileNummern und oben die Nummern stehen hast kannst du es so machen

Worksheets("Neue_Daten_Save").Range("D2:F5").FormulaR1C1 = "=IFERROR(VLOOKUP(RC3, _
Alte_Daten_Save!R2C2:R16C5,R1C+1,0),)"
Gruß Basti
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 10:44:48
Andy
Super das klappt schon mal Prima.
Geht sowas auch wenn zB zwischen der Teilenummer und den Zellen die kopiert werden sollen Zellen sind die nicht kopiert werden sollen?
Hab es mal wieder als Datei angehängt
https://www.herber.de/bbs/user/107401.xlsm
Anzeige
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 10:45:30
Andy
Super das klappt schon mal Prima.
Geht sowas auch wenn zB zwischen der Teilenummer und den Zellen die kopiert werden sollen Zellen sind die nicht kopiert werden sollen?
Hab es mal wieder als Datei angehängt
https://www.herber.de/bbs/user/107401.xlsm
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 13:04:35
baschti007
Hey Andi wenn du Gut VBA kannst wieso willst du des dann mit den Excel Formeln lösen ?
Und hast du schon mal den Makrorecorder benutzt der gibt dir die passende Lösung ;)

Worksheets("Neue_Daten_Save").Range("D2:I20").FormulaR1C1 = "=IFERROR(VLOOKUP(RC3,  _
Alte_Daten_Save!R2C2:R16C7,R1C+2,0),)"

Gruß Basti
Anzeige
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 13:12:41
Andy
Ich muss gestehen das mir dazu keine schnelle Lösung mit dem vergleichen eingefallen ist.
Wenn ich das ohne Excel Formeln hinbekommen kann wäre mir das lieber.
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 13:34:57
baschti007
Hmm ja aber das ist doch recht simpel dann würde ich vielleicht deine Beschreibung VBA GUt nicht angeben . Nun ja wie auch immer =D Hier ganz einfach
Sub suchen()
Dim WsA As Worksheet
Dim WsN As Worksheet
Dim rngsuch As Range
Dim rngfinden As Range
Dim Zells As Range
Dim Zellf As Range
Set WsA = ThisWorkbook.Worksheets("Alte_Daten_Save")
Set WsN = ThisWorkbook.Worksheets("Neue_Daten_Save")
Set rngsuch = WsN.Range(WsN.Cells(2, "C"), WsN.Cells(WsN.Cells(1048576, "C").End(xlUp).Row, "C") _
)
Set rngfinden = WsA.Range(WsA.Cells(2, "B"), WsA.Cells(WsA.Cells(1048576, "B").End(xlUp).Row, " _
B"))
For Each Zells In rngsuch
For Each Zellf In rngfinden
If Zells.Value = Zellf.Value Then WsN.Range("G" & Zells.Row & ":" & "I" & Zells.Row) = WsA. _
Range("D" & Zellf.Row & ":" & "F" & Zellf.Row).Value
Next
Next
End Sub

Anzeige
AW: VBA erstellen um einen SVerweiss zu ersetzen
04.08.2016 13:40:23
baschti007
Oder so mit FIND ;)
Sub suchen1()
Dim WsA As Worksheet
Dim WsN As Worksheet
Dim rngsuch As Range
Dim rngfinden As Range
Dim Zells As Range
Dim Zellf As Range
Set WsA = ThisWorkbook.Worksheets("Alte_Daten_Save")
Set WsN = ThisWorkbook.Worksheets("Neue_Daten_Save")
Set rngsuch = WsN.Range(WsN.Cells(2, "C"), WsN.Cells(WsN.Cells(1048576, "C").End(xlUp).Row, "C") _
)
Set rngfinden = WsA.Range(WsA.Cells(2, "B"), WsA.Cells(WsA.Cells(1048576, "B").End(xlUp).Row, " _
B"))
For Each Zells In rngsuch
Set Zellf = rngfinden.Find(Zells, LookIn:=xlValues, LookAt:=xlWhole)
If Zells.Value = Zellf.Value Then WsN.Range("G" & Zells.Row & ":" & "I" & Zells.Row) = WsA. _
Range("D" & Zellf.Row & ":" & "F" & Zellf.Row).Value
Next
End Sub

Anzeige

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige