Anzeige
Archiv - Navigation
936to940
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
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Paare erkennen und zusammensetzen

Paare erkennen und zusammensetzen
31.12.2007 14:07:23
Daniel
Moin,
ich habe eine Adressenliste wo jeder Name in einer eigenen Zeile steht.
Jetzt habe ich diesen Code:

Sub Übertrage_In_Neue()
Dim wkb1 As Workbook
Dim wks1 As Worksheet
Dim wkb2 As Workbook
Dim wks2 As Worksheet
Dim myArray()
Dim A As Long
Dim l As Long
Set wkb1 = ThisWorkbook
Set wks1 = wkb1.Worksheets("Tabelle1")
Application.ScreenUpdating = False
l = 0
For A = 1 To wks1.CheckBoxes.Count
If wks1.CheckBoxes(A) = 1 Then
l = l + 1
ReDim Preserve myArray(l)
myArray(l) = wks1.Rows(Cells(A + 7, 1).Row).Address
End If
Next A
Set wkb2 = Workbooks.Add
Set wks2 = wkb2.Worksheets("Tabelle1")
wks1.Range("7:7").Copy
wks2.Range("A1").PasteSpecial
For l = 1 To UBound(myArray)
wks1.Range(myArray(l)).Copy
wks2.Range("a" & l + 1).PasteSpecial
Next l
wks2.Range("A:A").Clear
wks2.Cells.Sort Key1:=wks2.Range("C2"), Order1:=xlAscending, Key2:=wks2.Range("E2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
For A = wks2.Range("B65000").End(xlUp).Row To 2 Step -1
If (wks2.Cells(A, 3) & wks2.Cells(A, 5)) = (wks2.Cells(A - 1, 3) & wks2.Cells(A - 1, 5))  _
Then
wks2.Cells(A - 1, 4) = wks2.Cells(A - 1, 4) & " und " & wks2.Cells(A, 4)
wks2.Rows(wks2.Cells(A, 3).Row).Delete Shift:=xlUp
End If
Next A
wks2.Cells.Columns.AutoFit
wks2.Range("A1").Select
Application.ScreenUpdating = True
End Sub


Womit der Nachname und die Straße überprüft wird und wenn ein Paar gefunden wurde, werden diese mit einem "und" zusammengesetzt und in eine neue Tabelle kopiert.
Jetzt habe ich das Problem, wenn drei oder mehrere Personen den gleichen Namen und Straße haben werden die ja auch mit dem "und" zusammengefügt, das sieht dann so aus: Vorname1 und Vorname2 und Vorname3 Nachname. Kann man dann nicht zwischen den 1. und 2. Name ein Komma sezten?
Kann mir einer dabei Helfen?
Ich wünsch euch noch einen guten Start ins Jahr 2008.
mfg
Daniel

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Paare erkennen und zusammensetzen
31.12.2007 14:20:28
Josef
Hallo Daniel,
ungetestet.

'statt
wks2.Cells(A - 1, 4) = wks2.Cells(A - 1, 4) & " und " & wks2.Cells(A, 4)
'versuchst du
wks2.Cells(A - 1, 4) = wks2.Cells(A - 1, 4) & Iff(InStr(1, wks2.Cells(A, 4), " und ") > 0, ", ", _
" und ") & wks2.Cells(A, 4)


Gruß Sepp

@Josef: Kleiner Fehler...
31.12.2007 17:42:42
Luc:-?
...nicht Iff, sondern IIf wie bei MIIB (Men In Black II), Josef... ;-)
Guten Rutsch!
Luc :-?

Anzeige
@Luc:-? - Danke, war eben ungetestet;-(( o.T.
31.12.2007 18:15:56
Josef
Gruß Sepp

AW: @Luc:-? - Danke, war eben ungetestet;-(( o.T.
31.12.2007 19:08:00
Daniel
Ich danke euch beiden für die Hilfe!!
Funktioniert super!
wünsch euch nochmals guten Rutsch
mfg
Daniel

AW: @Josef: Kleiner Fehler...
02.01.2008 12:01:15
Daniel
Guten Tag,
Mir ist noch etwas aufgefallen, was ich ändern müsste.
Ich habe sehr viele Personen in meiner Liste, die den gleichen Nachnamen und in dem gleichen Haus wohnen, die aber nicht ein Ehepaar sind. Also sollen diese nicht zusammengefügt werden!
Jetzt müsste noch zusätzlich Spalte P überprüft werden, das nur Ehepaare zusammengefügt werden.
In Spalte P steht eine 1 für Ehepaar und eine 0 für kein Ehepaar!
Kann mir dabei nochmal jemand helfen?
mfg
Daniel

Anzeige
AW: @Josef: Kleiner Fehler...
02.01.2008 22:42:00
Daniel
Mir ist noch etwas eingefallen!
Zusätzlich sollte noch das Geschlecht überprüft werden, das in Spale H steht.
Wenn ein Paar das selbe Geschlecht hat, sollten diese natürlich auch nicht zusammengefügt werden!
mfg
Daniel

Ich brauche Hilfe!!!
03.01.2008 13:36:35
Daniel
kann mir dabei keiner Helfen?
Ich habe überhaupt kein Plan, wie ich das Umsetzen kann!!
mfg
Daniel

AW: Paare erkennen und zusammensetzen
03.01.2008 22:03:00
Gerd
Hallo Daniel,
so vielleicht (ungetestet).
.................
For A = wks2.Range("B65000").End(xlUp).Row To 2 Step -1
If wks2.Cells(A, 8) <> wks2.Cells(A - 1, 8) Then
If (wks2.Cells(A, 3) & wks2.Cells(A, 5)) = _
(wks2.Cells(A - 1, 3) & wks2.Cells(A - 1, 5)) Then
wks2.Cells(A - 1, 4) = _
wks2.Cells(A - 1, 4) & _
IIf(InStr(1, wks2.Cells(A, 4), " und ") > 0, ", ", _
" und ") & wks2.Cells(A, 4)
End If
End If
Next A
...........................
Gru8 Gerd
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige