Daten suchen und Identische löschen

Hallo,
hatte mich heute morgen schon mal an euch gewendet, aber hatte da einen fehler
gemacht, deshalb versuche ich es nochmal.
Ich hoffe ihr könnt mir helfen
Ich brauch für meine Tourenplanung, zu der gehörigen Tour Nr. alle Kunden die auf der Tour sind. Leider haben unsere Kunden Nachbestellungen und kommen öfters auf der Tour vor. Diese möchte ich in meiner Tourenplanung verhindern, dort brauche ich nur den Kunden einmal.Jetzt möchte ich über ein Makro alle Kunden zu der Tour von einem anderen Blatt suchen und doppelte Namen nicht wieder geben.
Das Makro sollte alle TourenNr. überprüfen und die Kunden ausgeben.
schaut euch mal meine Tabelle an dann seht ihr mein Problem.

Die Datei https://www.herber.de/bbs/user/1808.xls wurde aus Datenschutzgründen gelöscht

Danke schon mal im voraus für eure Mühe

Holger S.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Holger

leider hast du meine Fragen nicht beantwortet :-(
Wie kommen die TourNr in die Tabelle Tourenplanung? Die Spalte G ist nämlich leer!
Was ist mit den "fast gleichen" Kundennamen? Und den falschen Umlauten?

Ich habe mal trotzdem ein makro versucht, das folgendes macht:
Setze den Cursor in Tabelle Tourenplanung in eine Zeile, in der die Spalte G (TourNr) ausgefüllt ist, und starte das Makro. Es sucht dir die Kunden zusammen und füllt sie in Spalte H:


Sub KundenSuchen()
Dim i&, j%, letzte&, Tour, Kunde$(100), Anz%, Res$, found As Boolean
Tour = Cells(ActiveCell.Row, 7).Value
letzte = Worksheets("SAP").Cells(65536, 8).End(xlUp).Row
For i = 3 To letzte
If Worksheets("SAP").Cells(i, 8).Value = Tour Then
found = False
For j = 1 To Anz
If Worksheets("SAP").Cells(i, 9).Value = Kunde(j) Then
found = True
Exit For
End If
Next j
If Not found Then
Anz = Anz + 1
Kunde(Anz) = Worksheets("SAP").Cells(i, 9).Value
End If
End If
Next i
For i = 1 To Anz
Res = Res & Kunde(i) & vbCr
Next i
Res = Left(Res, Len(Res) - 1)
Cells(ActiveCell.Row, 8).Value = Res
End Sub

Melde dich, wie's weiter gehen soll.
Gruss
Martin

Sub KundenSuchen() Dim i&, j%, k&, letzte&, letzteT&, Tour, Kunde$(100), Anz%, Res$, found As Boolean letzte = Worksheets("SAP").Cells(65536, 8).End(xlUp).Row letzteT = Cells(65536, 7).End(xlUp).Row For k = 12 To letzteT If Not IsEmpty(Cells(k, 7)) Then Tour = Cells(k, 7).Value For i = 81 To letzte If Worksheets("SAP").Cells(i, 8).Value = Tour Then found = False For j = 1 To Anz If Worksheets("SAP").Cells(i, 9).Value = Kunde(j) Then found = True Exit For End If Next j If Not found Then Anz = Anz + 1 Kunde(Anz) = Worksheets("SAP").Cells(i, 9).Value End If End If Next i For i = 1 To Anz Res = Res & Kunde(i) & vbCr Next i If Res <> "" Then Res = Left(Res, Len(Res) - 1) Cells(k, 8).Value = Res Cells(k, 8).Rows.AutoFit 'Passt die Zeilenhöhe an End If Next k End Sub

Sub KundenSuchen() Dim i&, j%, k&, letzte&, letzteT&, Tour, Kunde$(100), Anz%, Res$, found As Boolean letzte = Worksheets("SAP").Cells(65536, 8).End(xlUp).Row letzteT = Cells(65536, 7).End(xlUp).Row For k = 12 To letzteT ' alle Zellen in Tourenplanung Spalte G If Not IsEmpty(Cells(k, 7)) Then Tour = Cells(k, 7).Value For i = 3 To letzte If Worksheets("SAP").Cells(i, 8).Value = Tour Then found = False For j = 1 To Anz If Worksheets("SAP").Cells(i, 9).Value = Kunde(j) Then found = True Exit For End If Next j If Not found Then Anz = Anz + 1 Kunde(Anz) = Worksheets("SAP").Cells(i, 9).Value End If End If Next i For i = 1 To Anz Res = Res & Kunde(i) & vbCr Next i If Res <> "" Then Res = Left(Res, Len(Res) - 1) Cells(k, 8).Value = Res Cells(k, 8).Rows.AutoFit 'Passt die Zeilenhöhe an End If Next k End Sub

Sub KundenSuchen() Dim i&, j%, k&, letzte&, letzteT&, Tour, Kunde$(100), Anz%, Res$, found As Boolean letzte = Worksheets("SAP").Cells(65536, 8).End(xlUp).Row letzteT = Cells(65536, 7).End(xlUp).Row For k = 12 To letzteT ' alle Zellen in Tourenplanung Spalte G If Not IsEmpty(Cells(k, 7)) Then Tour = Cells(k, 7).Value Res = "" Anz = 0 For i = 3 To letzte If Worksheets("SAP").Cells(i, 8).Value = Tour Then found = False For j = 1 To Anz If Worksheets("SAP").Cells(i, 9).Value = Kunde(j) Then found = True Exit For End If Next j If Not found Then Anz = Anz + 1 Kunde(Anz) = Worksheets("SAP").Cells(i, 9).Value End If End If Next i For i = 1 To Anz Res = Res & Kunde(i) & Chr(10) Next i If Res <> "" Then Res = Left(Res, Len(Res) - 1) Cells(k, 8).Value = Res Cells(k, 8).Rows.AutoFit 'Passt die Zeilenhöhe an End If Next k End Sub

Beliebteste Forumthreads (12 Monate)

Daten suchen und Identische löschen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten suchen und Identische löschen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread