Hallo zusammen,
in einem Excel Workbook wird beim Start das erste Tabellenblatt mit Sharepoint synchronisiert. Dabei werden viele unnötige leere Absätze in die Zellen geschrieben. Diese Absätze sind aber sehr unpraktisch weil die Tabelleneinträge später von Word (Seriendruckfunktion) übernommen werden....
Ich hab dieses löschen der Leer-Absätze mittels VBA gelöst, allerdings reichen meine Programmierkenntnisse nicht aus, das in einer Loopschleife o.ä. zu verpacken.
Ich erbitte hiermit also eure Hilfe den ganzen Code etwas eleganter zu gestalten:
in einem Excel Workbook wird beim Start das erste Tabellenblatt mit Sharepoint synchronisiert. Dabei werden viele unnötige leere Absätze in die Zellen geschrieben. Diese Absätze sind aber sehr unpraktisch weil die Tabelleneinträge später von Word (Seriendruckfunktion) übernommen werden....
Ich hab dieses löschen der Leer-Absätze mittels VBA gelöst, allerdings reichen meine Programmierkenntnisse nicht aus, das in einer Loopschleife o.ä. zu verpacken.
Ich erbitte hiermit also eure Hilfe den ganzen Code etwas eleganter zu gestalten:
Quellcode
- Private Sub Workbook_Open()
- 'Daten aktualisieren
- ActiveWorkbook.RefreshAll
- 'Aus Spalten unnötige Absätze löschen
- Dim arr, tmp As String, sp As Integer, k As Integer, i As Long
- sp = 1
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 2
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 3
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 4
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 5
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 6
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 7
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 8
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 9
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 10
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 11
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 12
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- sp = 13
- For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
- arr = Split(Cells(i, sp).Value, vbLf)
- For k = LBound(arr) To UBound(arr)
- If Trim(arr(k)) <> "" Then tmp = tmp & arr(k) & vbLf
- Next k
- If tmp <> "" Then Cells(i, sp) = Left(tmp, Len(tmp) - 1)
- tmp = ""
- Next i
- End Sub