Excel - nur jede 10. Zeile wird benötigt

JoPo

Hi zusammen,

wer kann mir bei folgender Aufgabe helfen:
Es gibt ein Dokument mit zig-tausend Zeilen. Alles Zufallscodes.
Nun sollen immer 10 Codes zu einem einzigen zusammengefasst werden.
Es gint eine Überschrift, die auch bleiben muss. Im Moment sieht das mit der folgenden Zeile gut aus.
=A2&","&" "&A3&","&" "&A4&","&" "&A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11
Wie kann ich die nächsten Zeile bei A12 beginnen lassen, bei A21 endend.
Nächste Zeile müsste von A22 bis A31 sein, dann A32 bis A41.
Beim normalen Hochzählen wird die ganze Reihe zwar um eine Ziffer hochgesetzt, ich bräuchte aber 10er Sprünge.

Nochmals:
Mein bisheriges Ergebnis ist also:
=A2&","&" "&A3&","&" "&A4&","&" "&A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11
=A3&","&" "&A4&","&" "&A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11&","&" "&A12
=A4&","&" "&A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11&","&" "&A12&","&" "&A13
=A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11&","&" "&A12&","&" "&A13&","&" "&A14

Ich brauche:
=A2&","&" "&A3&","&" "&A4&","&" "&A5&","&" "&A6&","&" "&A7&","&" "&A8&","&" "&A9&","&" "&A10&","&" "&A11
=A12&","&" "&A13&","&" "&A14&","&" "&A15&","&" "&A16&","&" "&A17&","&" "&A18&","&" "&A19&","&" "&A20&","&" "&A21
=A22&","&" "&A23&","&" "&A24&","&" "&A25&","&" "&A26&","&" "&A27&","&" "&A28&","&" "&A29&","&" "&A30&","&" "&A31
usw.

Edit:
Andere Möglichkeit wäre: Meine bisherige Vorgehensweise kann bleiben. Dann müssten die Ergebnisse als Text festgeschrieben werden, danach folgende Zeilen löschen: A3 bis A11, A13 bis A21, A23 bis A31, A33 bis A41 usw.
Kann mir jemend einen Tipp geben solcherlei Zeilenlöschvorautomatismus hinzubekommen?

Bitte um Tipps.
Salü
Joachim

JoPo

Hin zusammen,

ich habe ein Beispiel angehängt.
Da ist zu erkennen wie die Zusammenfassung sein soll, und daraus welche Zeilen gelöscht werden können, nachdem die Zusammenfassung als unveränderlich eingesetzt wurde.

Salü
Joachim

Klaus79

Hallo Jochen
mit folgendem Makro:

Sub Zertnummern()
Dim i As Long
Dim lngLast As Long
'letzte Zeile von Spalte A
lngLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False

'Formeln setzen
For i = 2 To lngLast Step 10
Range("E" & i).FormulaR1C1 = _
"=RC[-4]&"",""&"" ""&R[1]C[-4]&"",""&"" ""&R[2]C[-4]&"",""&"" ""&R[3]C[-4]&"",""&"" ""&R[4]C[-4]&"",""&"" ""&R[5]C[-4]&"","" &"" ""&R[6]C[-4]&"",""&"" ""&R[7]C[-4]&"",""&"" ""&R[8]C[-4]&"",""&"" ""&R[9]C[-4]"
Next i
'Formeln werden Value
Range("E2:E" & lngLast).Value = Range("E2:E" & lngLast).Value

'Loeschen
Range("E2:E" & lngLast).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
End Sub

Die lange Formel muss später in einer Zeile stehen ...

Gruß
Klaus

JoPo

Hallo Klaus,

vielen vielen Dank, das funktioniert phantastisch.
Ich bin begeistert was man so alles machen kann wenn man sich auskennt.

Ich wünsche Dir einen sonnigen Tag
Joachim

JoPo

Hallo Klaus,
leider ist die Anforderung geändert worden.
Es sollen jetzt immer 100 Zeilen zusammengefasst werden.
Ich habe das angepasst wie von Dir vorbereitet.
Hier meine Änderung:

Sub Zertnummern()
Dim i As Long
Dim lngLast As Long
'letzte Zeile von Spalte A
lngLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False

'Formeln setzen
For i = 2 To lngLast Step 100
Range("E" & i).FormulaR1C1 = _
"=RC[-4]&"",""&"" ""&R[1]C[-4]&"",""&"" ""&R[2]C[-4]&"",""&"" ""&R[3]C[-4]&"",""&"" ""&R[4]C[-4]&"",""&"" ""&R[5]C[-4]&"","" &"" ""&R[6]C[-4]&"",""&"" ""&R[7]C[-4]&"",""&"" ""&R[8]C[-4]&"",""&"" ""&R[9]C[-4]&"",""&"" ""&R[10]C[-4]&"",""&"" ""&R[11]C[-4]&"",""&"" ""&R[12]C[-4]&"",""&"" ""&R[13]C[-4]&"",""&"" ""&R[14]C[-4]&"",""&"" ""&R[15]C[-4]&"",""&"" ""&R[16]C[-4]&"",""&"" ""&R[17]C[-4]&"",""&"" ""&R[18]C[-4]&"",""&"" ""&R[19]C[-4]&"",""&"" ""&R[20]C[-4]&"",""&"" ""&R[21]C[-4]&"",""&"" ""&R[22]C[-4]&"",""&"" ""&R[23]C[-4]&"",""&"" ""&R[24]C[-4]&"",""&"" ""&R[25]C[-4]&"",""&"" ""&R[26]C[-4]&"",""&"" ""&R[27]C[-4]&"",""&"" ""&R[28]C[-4]&"",""&"" ""&R[29]C[-4]&"",""&"" ""&R[30]C[-4]&"",""&"" ""&R[31]C[-4]&"",""&"" ""&R[32]C[-4]&"",""&"" ""&R[33]C[-4]&"",""&"" ""&R[34]C[-4]&"",""&"" ""&R[35]C[-4]&"",""&"" ""&R[36]C[-4]&"",""&"" ""&R[37]C[-4]&"",""&"" ""&R[38]C[-4]&"",""&"" ""&R[39]C[-4]&"",""&"" ""&R[40]C[-4]&"",""&"" ""&R[41]C[-4]&"",""&"" ""&R[42]C[-4]&"",""&"" ""&R[43]C[-4]&"",""&"" ""&R[44]C[-4]"
&"",""&"" ""&R[45]C[-4]&"",""&"" ""&R[46]C[-4]&"",""&"" ""&R[47]C[-4]&"",""&"" ""&R[48]C[-4]&"",""&"" ""&R[49]C[-4]&"",""&"" ""&R[50]C[-4]&"",""&"" ""&R[51]C[-4]&"",""&"" ""&R[52]C[-4]&"",""&"" ""&R[53]C[-4]&"",""&"" ""&R[54]C[-4]&"",""&"" ""&R[55]C[-4]&"",""&"" ""&R[56]C[-4]&"",""&"" ""&R[57]C[-4]&"",""&"" ""&R[58]C[-4]&"",""&"" ""&R[59]C[-4]&"",""&"" ""&R[60]C[-4]&"",""&"" ""&R[61]C[-4]&"",""&"" ""&R[62]C[-4]&"",""&"" ""&R[63]C[-4]&"",""&"" ""&R[64]C[-4]&"",""&"" ""&R[65]C[-4]&"",""&"" ""&R[66]C[-4]&"",""&"" ""&R[67]C[-4]&"",""&"" ""&R[68]C[-4]&"",""&"" ""&R[69]C[-4]&"",""&"" ""&R[70]C[-4]&"",""&"" ""&R[71]C[-4]&"",""&"" ""&R[72]C[-4]&"",""&"" ""&R[73]C[-4]&"",""&"" ""&R[74]C[-4]&"",""&"" ""&R[75]C[-4]&"",""&"" ""&R[76]C[-4]&"",""&"" ""&R[77]C[-4]&"",""&"" ""&R[78]C[-4]&"",""&"" ""&R[79]C[-4]&"",""&"" ""&R[80]C[-4]&"",""&"" ""&R[81]C[-4]&"",""&"" ""&R[82]C[-4]&"",""&"" ""&R[83]C[-4]&"",""&"" ""&R[84]C[-4]&"",""&"" ""&R[85]C[-4]&"",""&"" ""&R[86]C[-4]&"",""&"" ""&R[87]C[-4]&"",""&"" ""&R[88]C[-4]
&"",""&"" ""&R[89]C[-4]&"",""&"" ""&R[90]C[-4]&"",""&"" ""&R[91]C[-4]&"",""&"" ""&R[92]C[-4]&"",""&"" ""&R[93]C[-4]&"",""&"" ""&R[94]C[-4]&"",""&"" ""&R[95]C[-4]&"",""&"" ""&R[96]C[-4]&"",""&"" ""&R[97]C[-4]&"",""&"" ""&R[98]C[-4]&"",""&"" ""&R[99]C[-4]&"",""&"" ""&R[100]C[-4]"
Next i
'Formeln werden Value
Range("E2:E" & lngLast).Value = Range("E2:E" & lngLast).Value

'Loeschen
Range("E2:E" & lngLast).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
End Sub

Da jetzt die Zeile "=RC[-4]&"",""&"" ""&....... bis 100 fortgeführt wird findet ein Zeilenumbruch statt, der angemostert wird.
Wie kann ich umgehen?

Salü
Joachim

Klaus79

Hallo Joachim,
da sollte man dann eine zusätzliche Funktion einbauen:

Sub Zertnummern()
Dim i As Long
Dim lngLast As Long
'letzte Zeile von Spalte A
lngLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False

'Formeln setzen
For i = 2 To lngLast Step 100
Range("E" & i).FormulaR1C1 = "=Zert(RC[-4]:R[99]C[-4])"
Next i
'Formeln werden Value
Range("E2:E" & lngLast).Value = Range("E2:E" & lngLast).Value

'Loeschen
Range("E2:E" & lngLast).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
End Sub

Function Zert(Bereich As Range) As String
Dim Zelle As Range
Application.Volatile
For Each Zelle In Bereich.Cells
If Zelle.Value <> "" Then
If Zert = "" Then
Zert = Cells(Zelle.Row, 1).Value
Else
Zert = Zert & ", " & Cells(Zelle.Row, 1).Value
End If
End If
Next Zelle
End Function

Gruß
Klaus

JoPo

Hallo Klaus,

auwei, nun wird es mir zu kompliziert um es zu verstehen.
Vielen Dank. Das werde ich morgen früh testen und Dir Meldung machen.

Salü und einen schönen Abend
Joachim

JoPo

Hallo Klaus,

funktioniert leider nur teilweise.
Das Löschen der nicht mehr benötigten Zeilen passt, aber als Ergenbis der Zusammenfassung kommt nur #NAME? in Spalte E.
Beim kopieren des makros ist zwischen
...
End Sub

Function Zert(Ber....
ist eine Trennlinie im Editor zu erkennen.

Salü
Joachim

Klaus79

Moin,

dann hast Du sicherlich ein Hochkomma vor
Range("E2:E" & lngLast).Value = Range("E2:E" & lngLast).Value
gesetzt(?). Das müsste raus.

Schreib mal händisch in Zelle E2
=Zert(A2:A101)
Das ist nämlich die Formel, die per Makro eingegeben wird.

Zweite Möglichkeit: Du hast ein altes Excel, dass eine Zell-Limitierung von
256 Zeichen hat. Dann kann das natürlich nicht funktionieren weil
Du hier erheblich mehr Zeichen bekommst ...

Gruß
Klaus

JoPo

Hallo Klaus,
meine Excel ist Version 2011 Mac.
Ich habe im Macro alle Zeilen mit Hochkomma geläscht. Geht dennoch nicht.
Ich habe eine Spalte eingefügt um zu überwachen ob wirklich immer die 100. Zeile benutzt wird. Das stimmt perfekt.
Nur das Einsetzen der hundert Codes zusammengefasst klappt nicht.Anbei mal die aktuelle Datei, schau mal rein ob es bei dir funktioniert. Vielleicht ist noch ein Kopierproblem aus dem Forum drin.
As Anhang ist die Datei zu groß, der hier ein Link dazu:
https://dl.dropboxusercontent.com/u/69229719/Zertifkat%20TEST-Nummern_06_komplett_automatisiertesMacro.xlsm.zip
Salü
Joachim

Klaus79

Hallo Joachim,
das Problem ist, dass sich Excel einen Wolf rechnet :-)

Ich habe nun einfach nach jeder Formeleingabe die Zelle sofort
in Werte umrechnen lassen und schon klappt es:

Sub Zertnummern()
Dim i As Long
Dim lngLast As Long
lngLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lngLast Step 100
Range("E" & i).FormulaR1C1 = "=Zert(RC[-4]:R[99]C[-4])"
Range("E" & i).Value = Range("E" & i).Value
Next i
Range("E2:E" & lngLast).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

(Die Funktion kann so bleiben.)

Frohes Gelingen!
Gruß
Klaus

JoPo

Hallo Klaus,
mein Excel rechnet anders als Deines. Schade.
Es bleibt so dass alle nicht mehr benötigten Zeilen gelöscht werden. Prima.
Leider ist in den Zeilen ab E2 überall #NAME? drin.
Da ich morgen früh abliefern muss, habe ich es jetzt halb-manuell zusammengeführt.
Ich werde aber weitere 50.000 Codes am Freitag erhalten, und wenn alles klappt sollen noch 1,2 Mio Codes demnächst folgen.
Danke für deine Hilfe.
Joachim

Klaus79

Hallo Jochen,
das Ergebnis als Festwerte:

http://www.cshare.de/file/db3588ad6323ba81bd302dd1bd607fe1/Zertifkat+TEST-Nummern_06_komplett_automatisiertesMacro.xlsm.html

In dieser (Deiner) Datei ging es bei mir.
Wir sollten morgen noch einmal auf Fehlersuche gehen.
Alternativ: sende mir die Daten und ich klick einmal drauf und fertig ...

Gruß
Klaus

Klaus79

Sorry. Ich meine natürlich Joachim.
Jochen heißt ein Freund von mir.
:-)