Hallo an alle
Ich versuche ein Macro zu generieren, dass mir eine Mappe aufräumt, bzw. richtig sortiert.
Anbei zwei xls Dateien, Before.xls und After.xls. Sinngemäß soll das Macro Before.xls so sortieren, dass es aussieht wie After.xls
Vielen Dank für Eure Hilfe !
Hallo
und was hat das mit sortieren zu tun?
in der Datei "After" sind doch nur die Leerzellen wech
btw hast du die Leute in der Liste gefragt ob sie mit Adresse und Tel-Nummer
sowie Email im Internet veröffentlicht werden wollen?
MfG Tom
(17.03.2017, 22:13)Crazy Tom schrieb: [ -> ]Hallo
und was hat das mit sortieren zu tun?
in der Datei "After" sind doch nur die Leerzellen wech
btw hast du die Leute in der Liste gefragt ob sie mit Adresse und Tel-Nummer
sowie Email im Internet veröffentlicht werden wollen?
MfG Tom
Danke für den hinweis Tom, ich habe irrtümlicherweise "echte Daten" angehängt. Moderator möchte die Anhänge bitte löschen
(17.03.2017, 22:34)elgato2000 schrieb: [ -> ]Danke für den hinweis Tom, ich habe irrtümlicherweise "echte Daten" angehängt. Moderator möchte die Anhänge bitte löschen
Wenn Du genau hingeschaut hast, lag das Problem tiefer und nicht nur in leeren Zellen.
Hallo,
Deine Beharrlichkeit zahlt sich aus, denke ich:
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
Range(Cells(i - 1, 6), Cells(i + jj - 1, 6)) = Range(Cells(i, 6), Cells(i + jj, 6)).Value
Next jj
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
End If
Next i
End Sub
Hallo Atilla !
Fast perfekt. Du bist echt ne Wucht.
Aaaaaaaaaber:
irgendwas stimmt nicht.
Angehängter file, schau mal. Und pack mal deinen Code darein.
Hallo,
machen wir anders. Sag was nicht stimmt. Ich such jetzt nicht rum.
Ok klar.
z.B. Yvonn Hell
Die gute Dame hat bestellt:
Greenspace 1P Weltall
Universum 4LP Weltraum Space
New Sunset Sonnenuntergang Natur Meer Sonne Pano
Daher muss das auch so in den Zeilen stehen, ohne Leerzelle in Spalte F
Wenn ich dein Macro laufen lass, steht da dann aber andere Namen
Hallo,
ok, hab's gerade auch gesehen.
Teste mal:
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
End If
Next i
End Sub
siehe Anlage, nachdem das Macro gelaufen ist