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

Werte aus Tabellenbereich in andere Tabelle überge

Werte aus Tabellenbereich in andere Tabelle überge
06.05.2019 14:27:23
Erwin
Hallo Excel-Experten,
ich möchte automatisiert eine Telefon-Nebenstellenliste erstellen. Dazu bekomme ich von einer DB die nötigen Daten per Daten-Import. In Spalte A stehen die Abteilungen, in B die Nebenstellen und in C die Namen der Kollegen. Das ist die Tabelle qry_Telefonliste.
Aus dieser möchte ich dann in die Tabelle Nebenstellenverzeichnis ab Zeile 14 pro Abt. die Nummern und Namen untereinander schreiben lassen. Die Abteilungen selber stehen nebeneinander, also in A14 und darunter die Mitarbeiter der Abt1, in C14 und darunter die Mitarbeiter der Abt.2 usw.
Folgenden Code habe ich mir zusammengebastelt, der auch (fast) funktioniert:
Sub nebenstellen_Neu()
'Suchbegriffe definieren
sb1 = "Abt1"
sb2 = "Abt2"
usw.
'Quelle definieren
qtab = "qry_Telefonliste" 'Quelldaten
qspalte = "A" 'Quellspalte, in der gesucht wird
spaltenanzahl = 2 'Anzahl daneben liegender Spalten, aus denen der Wert übertragen werden soll
'Ziel definieren
ztab = "Nebenstellenverzeichnis" 'Zieltabelle
zz = 14 'Übertrag aller Daten ab dieser Zeile
zsAbt1 = "A" 'Übertrag der Daten für Abt1 in dieser Spalte
zsAbt2 = "C" 'Übertrag der Daten für Abt2 in dieser Spalte
zsAbt3 = "E" 'Übertrag der Daten für Abt3 in dieser Spalte
...usw
'Allgemeine Definition
Set q = Worksheets(qtab)
Set Z = Worksheets(ztab)
zzeile = zz 'Startzeile in der Zieldatei
'Abt1
With q.Columns(qspalte)
Set gefunden = .Find(sb1, LookIn:=xlValues) 'Suchspalte der Quelldatei durchsuchen
If Not gefunden Is Nothing Then 'nur wenn der Suchbegriff gefunden wurde, nachfolgende  _
Schritte durchführen
Do 'für alle Fundstellen
Z.Cells(zzeile, zsAbt1).Resize(1, spaltenanzahl) = gefunden.Offset(0, 1).Resize(1,  _
spaltenanzahl).Value 'Werte der Nachbarzellen übertragen
zzeile = zzeile + 1 'Zeilennummer in der Zieltabelle um 1 erhöhen
Set gefunden = .FindNext(gefunden) 'Nächste Fundstelle suchen
Loop Until gefunden  sb1 'Solange suchen wie Suchbegriff vorhanden
End If
zzeile = zz
End With
'Abt2
With q.Columns(qspalte)
Set gefunden = .Find(sb2, LookIn:=xlValues) 'Suchspalte der Quelldatei durchsuchen
If Not gefunden Is Nothing Then 'nur wenn der Suchbegriff gefunden wurde, nachfolgende  _
Schritte durchführen
Do 'für alle Fundstellen
Z.Cells(zzeile, zsAbt2).Resize(1, spaltenanzahl) = gefunden.Offset(0, 1).Resize(1,  _
spaltenanzahl).Value 'Werte der Nachbarzellen übertragen
zzeile = zzeile + 1 'Zeilennummer in der Zieltabelle um 1 erhöhen
Set gefunden = .FindNext(gefunden) 'Nächste Fundstelle suchen
Loop Until gefunden  sb2 'Solange suchen wie Suchbegriff vorhanden
End If
zzeile = zz
End With
...usw
End Sub
Nun habe ich 2 Probleme:
Die erste With-Anweisung für Abt1 klappt wunderbar, sucht alle Nr. und Namen nach dem Suchbegriff und schreibt diese sauber in das Tabellenblatt Nebenstellenverzeichnis.
Fängt dann auch mit der nächsten Abteilung an und schreibt diese rein, aber
es hört nicht mehr auf! Wenn alle Namen der Abteilung abgearbeitet sind, fängt es wieder von vorne an und es werden wieder alle Namen dieser Abt. untereinander geschrieben. Irgendwie habe ich da eine Dauerschleife. Aber warum, bei der ersten Anweisung gehts ja auch!
Das zweite Problem ist, es werden auch ab und zu Namen ohne Tel-Nr. importiert. Kann ich da noch so eine Art Wenn-Dann-Bedingung einbauen, dass wenn keine Nebenstelle in den Quelldaten angegeben ist der Name auch nicht übernommen werden soll?
Für eine Antwort wäre ich sehr dankbar!
Schöne Grüße
Erwin

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte aus Tabellenbereich in andere Tabelle überge
06.05.2019 20:19:18
Rob
Hi Erwin,
Du benötigst für die do loop-Schleife die jeweilige Adresse:

sb2 = gefunden.Address
Loop Until gefunden.Address  sb2


With q.Columns(qspalte)
Set gefunden = .Find(sb2, LookIn:=xlValues) 'Suchspalte der Quelldatei durchsuchen
If Not gefunden Is Nothing Then 'nur wenn der Suchbegriff gefunden wurde, nachfolgende _
Schritte durchführen
sb2 = gefunden.Address
Do 'für alle Fundstellen
Z.Cells(zzeile, zsAbt2).Resize(1, spaltenanzahl) = gefunden.Offset(0, 1).Resize(1,  _
_
spaltenanzahl).Value 'Werte der Nachbarzellen übertragen
zzeile = zzeile + 1 'Zeilennummer in der Zieltabelle um 1 erhöhen
Set gefunden = .FindNext(gefunden) 'Nächste Fundstelle suchen
Loop Until gefunden.Address  sb2 'Solange suchen wie Suchbegriff vorhanden
End If
zzeile = zz
End With

Anzeige
AW: Werte aus Tabellenbereich in andere Tabelle überge
06.05.2019 20:23:14
Rob
Zum zweiten Problem: VBA hat die Funktion IsEmpty, die Du noch in eine if/then-Abfrage einbauen könntest. So z.B.:

If Not IsEmpty(gefunden.Offset(0, 3)) Then
'do something
End If

AW: klappt leider noch nicht
07.05.2019 09:32:57
Erwin
Hallo Rob,
danke für Deine Antwort und entschuldige bitte die späte Meldung. Bin erst jtzt wieder auf Arbeit.
Mit der Konstellation
sb2 = gefunden.Address
...
Loop Until gefunden.Address sb2
klappt es aber leider nicht, da kommt immer nur der erste Datensatz pro Abteilung, also
es werden keine weiteren Mitarbeiter daruntergeschrieben, nur eben der erste!
Und mit If Not IsEmpty(gefunden.Offset(0, 3)) Then
'do something
End If
kommen die Mitarbeiter ohne Tel-Nr. leider auch noch.
Ich bin schon mit allem möglich am probieren, aber es will einfach nicht.
Vielleicht gibts noch eine andere Lösung, wäre super
Schöne Grüße
Erwin
Anzeige
AW: klappt leider noch nicht
07.05.2019 09:38:45
Daniel
Hi - es müsste heißen
Loop Until gefunden.Address = sb2
Denn er soll ja so lange die Ergebnisse durchsuchen, bis er wieder beim ersten Treffer landet.
Gruß
Daniel
AW: klappt leider noch nicht
07.05.2019 10:28:10
Erwin
Hallo Daniel,
danke für die schnelle Antwort, jetzt schreibt er mir aber alle Mitarbeiter aller Abteilungen ab A14 runter, also alle in Spalte A und fängt nicht mehr daneneben mit der nächsten Abt. an!
Schöne Grüße
Erwin
AW: GELÖST, aber weitere Frage
07.05.2019 10:59:35
Erwin
Hallo Daniel und Rob,
bin jetzt selber drauf gekommen. Ihr hattet vollkommen recht, nur ich habe bei der nächsten with-Anweisung vergessen, der Variablen zzeile(Zielzeile) den Wert 14 wieder zu verpassen.
Sorry, meine Schuld, aber vielen Dank euch beiden!
Ich hätte aber noch zu der zweiten Antwort von Rob eine Frage:
Damit die Namen von denen, bei der keine Nebenstelle mit importiert wurde, nicht übernommen wird hat Rob mir den Tipp
If Not IsEmpty(gefunden.Offset(0, 3)) Then
'do something
End If
gegeben.
Die Namen (ohne Tel-Nr.) werden aber trotzdem übernommen.
Wo muss ich den Code genau anpassen?
Schöne Grüße und vielen Dank nochmals
Erwin
Anzeige
AW: GELÖST, aber weitere Frage
07.05.2019 17:51:02
Rob
Hi Erwin,
in welcher Spalte stehen denn die Nebenstellen?

If Not IsEmpty(gefunden.Offset(0,3)) 
sagt aus, dass in der Spalte von gefunden + 0 Zeilen, + 3 Spalten überprüft wird, ob eine Zelle nicht leer ist. Das musst Du ggf. noch anpassen.
Grüße, Rob
AW: Danke
08.05.2019 10:04:19
Erwin
Hallo Rob,
natürlich, bin da total auf der Leitung gestanden - sorry.
Danke Dir!
Schöne Grüße
Erwin
AW: Gerne OT
08.05.2019 10:51:50
Rob
ot

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige