Macro um ein Workbook zu sortieren
#11
PERFEKT !!!!!!!

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

p.s. kann man die Doppelten Namen markieren ? z.B. Fettschrift ?
Top
#12
Hallo,

bei mir sieht es vorher so aus:

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

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


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
Gruß Atilla
Top
#18
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.
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • elgato2000
Top
#19
Hi !!

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

Danke
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste