Macro um ein Workbook zu sortieren

[elgato2000]

PERFEKT !!!!!!!

Magst Dir mal ein Bild von mir aussuchen ? islandburner.com

p.s. kann man die Doppelten Namen markieren ? z.B. Fettschrift ?

[atilla]

Hallo,

bei mir sieht es vorher so aus:

Arbeitsblatt mit dem Namen 'Sheet1 (2)'
	B	C	D	E	F
2	Gunnar Baum c/o Francis Bächtiger		gunnarbaumlive		AHK-MFP
3	eleni Triantafyllidou		melinatriantgmail		Yoga Joga Feng Shui 4LP
4	Andrea Kurth / EVONIK		andrea-kurthweb		Speicherstadt V2 Hamburg Pano
5	Michel Rudolph		beastyboyrudweb		Marilyn Monroe V15-5p
6	Norbert Schefer		norbertsch63genion		AUT-4erP
7	Ilka Wölk		bellydancerhotmail		Strand V2 Nordseestrand Nordsee Ostsee Dünen Pano
8	Andreas Wetzig		lars.wetzigfreenet		BBG-3P
9	Sascha Schreiner		s.schreinert-online		Ostsee Strand Pano
10	Mirco Müskens		mm-87web		BEH-4LP
11	Nicole Ruß		nfl-russweb		Sepia Fahrrad 1K
12	Jörg Maier		joerg1404gmx		AZS-1P
13	Jörg Maier		joerg1404gmx		Strand V2 Nordseestrand Nordsee Ostsee Dünen 1P
14	Café kult		agbasgmx		Weg zum Meer Nordsee Strand 1P Edel
15	Christin Bayerl-Vargas		chribavagooglemail		Speicherstadt Hamburg 1P
16	Kevin Seidel		kev-jess-taylert-online		Abstract MFP
17	Kathrin Senftleben		lieka7gmx		ADL-1K
18	Carsten Grzybowski		vipermaxarcor		Al Pacino 1P Scarface
19	Frank Noak		saxodobslive		ANR-3P
20	Filip Fischer		filip.fischer1991gmx		Alte Weltkarte V2 Pano
21	Tim Schäfer		mail-timgmx		Strand V2 Nordsee Pano
22	Damien Franklin		dfranklin032gmail		Suntree MFP
23	Angela Kriegl		angela.remanegmx.net		Schatztruhe Tauchen im Meer MFP
24	Karoline Linke		karoline_linkeweb		BIH-MFP
25	Daniel Jaschke		d.jaschkeweb		AYF-MFP
26	Uwe Werner		werner.karinafreenet		ACW-1K
27	Katrin Sirl		katrin-sirlgmx		BKQ-MFP
28	Kay Wagner		kaywagner01aol		Bergsee V2 1P
29	Alexandra Bartsch		alexandrab1122gmail		ANZ-Pano
30	Mostafa Shohar		msshoharyahoo		Marilyn Monroe V7-1
31	elke bell		bangerthelmutgmail		ALA-MFP
32	Francyn Barge		francyn96web
33					Bengalischer Tiger V2 MFP
34					Bar Drinks Bartender Whiskey 4erP
35	Olesja  Pochilenko		alyona.alyona38gmail		Muhammad Ali MFP
36	Isabel Schwarzer		isabel_schwarzerweb		BDL-Pano
37	Peter Straub		straub.pbgmx		AAU-MFP
38	Marco Müller		versotechweb		Mojito Drinks Cocktails MFP
39	Yvonne Hell		yvohellhotmail
40					Greenspace 1P Weltall
41					Universum 4LP Weltraum Space
42					New Sunset Sonnenuntergang Natur Meer Sonne Pano
43	Frank Held		frankheld1313gmail		Harley Davidson 1P
44	Schorde		birgit.schordegmx		Weltkarte 100
45	Saskia Daller		saskia.dallerweb		Tiger 4erP
46	Robby Hiob		robbyfrontalgmail		Strand Sepia Nordseestrand Pano
47	Tony Bittner		tony.bittnerweb		Schattenspiel 1K
48	Lukas Staron		staron-lukaslive		AYF-4LP
49	Ferderer GmbH und Co.KG		ferdererhotmail		Japanischer Zen Garten 4LP
50	Birgit Fichter		b-fichtert-online		Buddha V10 100er
51	Dimitrios Andreadis		dimirimiweb		Blue Planet V2-MFP er
52	Andrea Stephan		engelchen69kabelmail		AEI-3P
53	Marco Bärwalde		derbaerwaldeaol
54					Banksy V2 Street Art 1P
55					Banksy Panoformat
56	Maik Kostyra		maik12697gmx		AUJ-Pano
57	Hellenbock Axel		axel.hellenbockfreenet		Dubai V2 Pano

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

und hinterher so:

Arbeitsblatt mit dem Namen 'Sheet1'
	B	C	D	E	F
2	Gunnar Baum c/o Francis Bächtiger		gunnarbaumlive		AHK-MFP
3	eleni Triantafyllidou		melinatriantgmail		Yoga Joga Feng Shui 4LP
4	Andrea Kurth / EVONIK		andrea-kurthweb		Speicherstadt V2 Hamburg Pano
5	Michel Rudolph		beastyboyrudweb		Marilyn Monroe V15-5p
6	Norbert Schefer		norbertsch63genion		AUT-4erP
7	Ilka Wölk		bellydancerhotmail		Strand V2 Nordseestrand Nordsee Ostsee Dünen Pano
8	Andreas Wetzig		lars.wetzigfreenet		BBG-3P
9	Sascha Schreiner		s.schreinert-online		Ostsee Strand Pano
10	Mirco Müskens		mm-87web		BEH-4LP
11	Nicole Ruß		nfl-russweb		Sepia Fahrrad 1K
12	Jörg Maier		joerg1404gmx		AZS-1P
13	Jörg Maier 2		joerg1404gmx		Strand V2 Nordseestrand Nordsee Ostsee Dünen 1P
14	Café kult		agbasgmx		Weg zum Meer Nordsee Strand 1P Edel
15	Christin Bayerl-Vargas		chribavagooglemail		Speicherstadt Hamburg 1P
16	Kevin Seidel		kev-jess-taylert-online		Abstract MFP
17	Kathrin Senftleben		lieka7gmx		ADL-1K
18	Carsten Grzybowski		vipermaxarcor		Al Pacino 1P Scarface
19	Frank Noak		saxodobslive		ANR-3P
20	Filip Fischer		filip.fischer1991gmx		Alte Weltkarte V2 Pano
21	Tim Schäfer		mail-timgmx		Strand V2 Nordsee Pano
22	Damien Franklin		dfranklin032gmail		Suntree MFP
23	Angela Kriegl		angela.remanegmx.net		Schatztruhe Tauchen im Meer MFP
24	Karoline Linke		karoline_linkeweb		BIH-MFP
25	Daniel Jaschke		d.jaschkeweb		AYF-MFP
26	Uwe Werner		werner.karinafreenet		ACW-1K
27	Katrin Sirl		katrin-sirlgmx		BKQ-MFP
28	Kay Wagner		kaywagner01aol		Bergsee V2 1P
29	Alexandra Bartsch		alexandrab1122gmail		ANZ-Pano
30	Mostafa Shohar		msshoharyahoo		Marilyn Monroe V7-1
31	elke bell		bangerthelmutgmail		ALA-MFP
32	Francyn Barge		francyn96web		Bengalischer Tiger V2 MFP
33	Francyn Barge 2		francyn96web		Bar Drinks Bartender Whiskey 4erP
34	Olesja  Pochilenko		alyona.alyona38gmail		Muhammad Ali MFP
35	Isabel Schwarzer		isabel_schwarzerweb		BDL-Pano
36	Peter Straub		straub.pbgmx		AAU-MFP
37	Marco Müller		versotechweb		Mojito Drinks Cocktails MFP
38	Yvonne Hell		yvohellhotmail		Greenspace 1P Weltall
39	Yvonne Hell 2		yvohellhotmail		Universum 4LP Weltraum Space
40	Yvonne Hell 3		yvohellhotmail		New Sunset Sonnenuntergang Natur Meer Sonne Pano
41	Frank Held		frankheld1313gmail		Harley Davidson 1P
42	Schorde		birgit.schordegmx		Weltkarte 100
43	Saskia Daller		saskia.dallerweb		Tiger 4erP
44	Robby Hiob		robbyfrontalgmail		Strand Sepia Nordseestrand Pano
45	Tony Bittner		tony.bittnerweb		Schattenspiel 1K
46	Lukas Staron		staron-lukaslive		AYF-4LP
47	Ferderer GmbH und Co.KG		ferdererhotmail		Japanischer Zen Garten 4LP
48	Birgit Fichter		b-fichtert-online		Buddha V10 100er
49	Dimitrios Andreadis		dimirimiweb		Blue Planet V2-MFP er
50	Andrea Stephan		engelchen69kabelmail		AEI-3P
51	Marco Bärwalde		derbaerwaldeaol		Banksy V2 Street Art 1P
52	Marco Bärwalde 2		derbaerwaldeaol		Banksy Panoformat
53	Maik Kostyra		maik12697gmx		AUJ-Pano
54	Hellenbock Axel		axel.hellenbockfreenet		Dubai V2 Pano

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Hast Du meinen zuletzt eingestellten Code getestet?

[elgato2000]

Ja jetzt is perfekt !

[elgato2000]

kann man die doppelten Name markieren ? Mit fett-schrift oder so ?

[atilla]

Hallo,

Fett so:

Code:

Sub mach_mal()
 Dim i As Long, j As Long, jj As Long
 Dim lngZ As Long
 lngZ = Cells(Rows.Count, 2).End(xlUp).Row
 For i = 2 To lngZ - 1
   If Cells(i, 2) = "" Then
     Do
       j = j + 1
     Loop Until Cells(i + j, 2) <> "" And j <= lngZ
       For jj = 1 To j - 1
         Cells(i + jj - 1, 2) = Cells(i - 1, 2) & " " & jj + 1
         Cells(i + jj - 1, 4) = Cells(i - 1, 4).Value
       Next jj
       Range(Cells(i - 1, 6), Cells(i + jj - 2, 6)) = Range(Cells(i, 6), Cells(i + jj - 1, 6)).Value
   End If
   j = 0
 Next i
 
 Range("B2:B" & lngZ).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 For i = 2 To lngZ
   jj = Application.CountIf(Range("B2:B" & i), Cells(i, 2))
   If jj > 1 Then
     Cells(i, 2) = Cells(i - 1, 2) & " " & jj
     Cells(i, 2).Font.Bold = True
   End If
 Next i
End Sub

Auf Dein Angebot komme ich noch zurück.
Ich muss mir erst mal einen Überblick verschaffen, welches das teuerste Bild ist. :19:

Spaß bei Seite, muss mal die Kinder Fragen. Danke aber, dass Du es überhaupt anbietest.

[elgato2000]

das mach ich sehr gerne !!

[atilla]

Hallo,

die zweite Schleife war überflüssig.
Alle Wünsche in folgenden Zeilen, auch der Wunsch nach Fett :

Code:

Sub mach_mal()
 Dim i As Long, j As Long, jj As Long
 Dim lngZ As Long
 lngZ = Cells(Rows.Count, 2).End(xlUp).Row
 For i = 2 To lngZ - 1
   If Cells(i, 2) = "" Then
     Do
       j = j + 1
     Loop Until Cells(i + j, 2) <> "" And j <= lngZ
       For jj = 1 To j - 1
         Cells(i + jj - 1, 2) = Cells(i - 1, 2) & " " & jj + 1
         Cells(i + jj - 1, 2).Font.Bold = True
         Cells(i + jj - 1, 4) = Cells(i - 1, 4).Value
       Next jj
       Range(Cells(i - 1, 6), Cells(i + jj - 2, 6)) = Range(Cells(i, 6), Cells(i + jj - 1, 6)).Value
   End If
   j = 0
 Next i
 
 Range("B2:B" & lngZ).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

[atilla]

Hallo,

unter bestimmten Gegebenheiten liefert der bisherige Code nicht die richtigen Ergebnisse.
Vor Allem dann nicht, wenn die zu korrigierenden Stellen am Ende der Liste auftauchen.

Deshalb unten eine neue Version:

Code:

Sub mach_mal()
 Dim i As Long, j As Long, jj As Long
 Dim lngZ As Long
 lngZ = Cells(Rows.Count, 6).End(xlUp).Row
 For i = 2 To lngZ - 1
   If Cells(i, 2) = "" Then
     Do While Cells(i + j, 2) = "" And i + j <= lngZ
       j = j + 1
     Loop
     For jj = 1 To j - 1
       Cells(i + jj - 1, 2) = Cells(i - 1, 2) & " " & jj + 1
       Cells(i + jj - 1, 2).Font.Bold = True
       Cells(i + jj - 1, 4) = Cells(i - 1, 4).Value
     Next jj
     Range(Cells(i - 1, 6), Cells(i + jj - 2, 6)) = Range(Cells(i, 6), Cells(i + jj - 1, 6)).Value
   End If
   j = 0
 Next i
 
 If jj > 0 Then Range("B2:B" & lngZ).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

Solltest Du vorhaben, die Liste irgendwie auszuwerten, dann würde ich an doppelte Namen keine Nummern anhängen, sondern so belassen.

[elgato2000]

Hi !!

habs jetzt ein paar mal getestet und es läuft einwandfrei !

Danke