SVWERWEIS mit VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Erich, erstmal schon mal danke für die schnelle response.
Wenn in den Grunddaten in Spalte A "HID" auftaucht, soll dies automatisch in die Filtertabelle übernommen werden inklusive der ausgewählten felder in einer von mir vorgegebenen reihenfolge. (Wie in der Beispieldatei (Filtertabelle) angegeben)
zu 1. in Spalte A steht die Abkürzung für einen Ort. Wenn jetzt jemand im Ort HID (HID = Platzhalter) lebt wird das in die Filtertabelle übernommen. Sollte aber Irgendwann dieser welcher nach Marl ziehen, muß die Zeile aus der Filtertabelle gelöscht werden.
zu 2. von links nach rechts anhängen, aber in einer Reihenfolge die ich bestimmen kann.
zu. Zusatzfrage Steht in Grunddaten Spalte A
Danke schon mal

Option Explicit Sub Kopie_spezial() Const strSuch = "HID" Dim wsGr As Worksheet, zz As Long, lngLast As Long Set wsGr = Sheets("Grunddaten") Sheets("Filterdaten").Activate For zz = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If InStr(Cells(zz, 1), strSuch) = 0 Then Application.Goto Cells(zz, 1), scroll:=True If MsgBox("Satz löschen?", vbYesNoCancel + vbQuestion, "Filtern") _ = vbYes Then Rows(zz).Delete End If Next zz lngLast = Cells(Rows.Count, 1).End(xlUp).Row For zz = 2 To wsGr.Cells(Rows.Count, 1).End(xlUp).Row If InStr(wsGr.Cells(zz, 1), strSuch) > 0 Then lngLast = lngLast + 1 wsGr.Cells(zz, 1).Copy Cells(lngLast, 1) wsGr.Cells(zz, 3).Copy Cells(lngLast, 2) wsGr.Cells(zz, 4).Copy Cells(lngLast, 3) wsGr.Cells(zz, 6).Copy Cells(lngLast, 4) wsGr.Cells(zz, 8).Copy Cells(lngLast, 5) End If Next zz Set wsGr = Nothing End Sub

Hallo Markus,
meine erste Rückfrage habe ich mir selbst jetzt so beantwortet:
Ein Quelldaten-Satz wird nicht in die Filterdaten übernommen, wenn er dort schon steht - unabhängig davon, wie oft er in den Quelldaten vorkommt.
Das macht folgende Prozedur:


Sub Kopie_spezial2()
Const strSuch = "HID"
Dim wsGr As Worksheet, zz As Long, lngLast As Long, vv As Long
Set wsGr = Sheets("Grunddaten")
Sheets("Filterdaten").Activate
For zz = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If InStr(Cells(zz, 1), strSuch) = 0 Then
Application.Goto Cells(zz, 1), scroll:=True
If MsgBox("Satz löschen?", vbYesNoCancel + vbQuestion, "Filtern") _
= vbYes Then Rows(zz).Delete
End If
Next zz
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
For zz = 2 To wsGr.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(wsGr.Cells(zz, 1), strSuch) > 0 Then
For vv = 2 To lngLast
If Cells(vv, 1) & "§$" & Cells(vv, 2) & "§$" _
& Cells(vv, 3) & "§$" & Cells(vv, 4) & "§$" _
& Cells(vv, 5) = _
wsGr.Cells(zz, 1) & "§$" & wsGr.Cells(zz, 3) & "§$" _
& wsGr.Cells(zz, 4) & "§$" & wsGr.Cells(zz, 6) & "§$" _
& wsGr.Cells(zz, 8) Then Exit For
Next vv
If vv > lngLast Then
lngLast = lngLast + 1
wsGr.Cells(zz, 1).Copy Cells(lngLast, 1)
wsGr.Cells(zz, 3).Copy Cells(lngLast, 2)
wsGr.Cells(zz, 4).Copy Cells(lngLast, 3)
wsGr.Cells(zz, 6).Copy Cells(lngLast, 4)
wsGr.Cells(zz, 8).Copy Cells(lngLast, 5)
End If
End If
Next zz
Set wsGr = Nothing
End Sub

Bereits in den Filterdaten vorhandene Dubletten werden NICHT gelöscht. Die kannst du nach
http://www.excelformeln.de/formeln.html?welcher=80
ei9nmalig herausfinden und per Hand löschen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
P.S.: Ist es denn wirklich so schwer, zwei Fragen zu beantworten? ;-)

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread