GLÄTTEN für gesamte Arbeitsmappe

Marcel · 2016-08-15T08:48:12+00:00

Hallo zusammen, ich habe eine sehr große Tabelle (7000 Zeilen und Spalten bis ED) bei der ich gerne die Funktion GLÄTTEN für sämtliche Zellen der Arbeitsmappe durchführen möchte. Gibt es da einen Weg, dies nicht manuell Spaltenweise machen zu müssen? Danke und Grüße

Hallo Marcel,
evtl. kannst du mit diesem Code von Rudi Maintaire (aus diesem Formum) etwas anfangen (gehört in ein Modul). Hier werden alle Leerzeichen und das Sonderzeichen 160 im ganzen Tabellenblatt (wenn alle Zellen markiert wurden) entnfernt und das geht sehr schnell. Hinweis: Wenn alle Zellen markiert werden sollen, dann nach Abfrage OBEN LINKS, zwischen "A" und "1" klicken, so wird die ganze Tabelle markiert. Evtl. können die Spezialisten dir dieses Makro so anpassen, dass durch die ganze Arbeitsmappe der Code durchläuft.
Gruß, Dieter(Drummer)
PS Ich hoffe Rudi hat nicht da´gegen, dass ich seinen Code hier weiter veröffentliche.
Makro aus Herber Forum: von Rudi Maintaire am 26.02.2016 11:39:50

Sub LeerzeichenUnd160Raus()
Dim r As Range
On Error Resume Next
Set r = Application.InputBox(prompt:="Bitte Bereich markieren", Type:=8)
On Error GoTo 0
If Not r Is Nothing Then
r.Replace Chr(32), "", xlPart
r.Replace Chr(160), "", xlPart
End If
End Sub

Hi zusammen,
das Makro von snb rennt bei mir auch nicht; ich habe mir die andere Variante angesehen:

Sub TrimCells()
Dim objSh As Worksheet
Dim rng As Range, rngR As Range
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.EnableEvents = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
For Each objSh In ThisWorkbook.Worksheets
On Error Resume Next
Set rngR = objSh.UsedRange.SpecialCells(xlCellTypeConstants)
Err.Clear
On Error GoTo ErrExit
If Not rngR Is Nothing Then
For Each rng In rngR
rng = Trim(rng)
Next
End If
Next
ErrExit:
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = lngCalc
End With
Set rng = Nothing
Set rngR = Nothing
Set objSh = Nothing
End Sub

Die ist wiederum insofern fehlerhaft, da sie NIE vorzeitig beendet wird, d.h. die Anweisung
On Error GoTo ErrExit
wird durch das Err.Clear in der vorhergehenden Zeile außer Kraft gesetzt.
Abhilfe:

Option Explicit
Sub TrimCells()
Dim objSh As Worksheet
Dim rng As Range, rngR As Range
Dim lngCalc As Long
Dim fehler As Long ' ******
On Error GoTo ErrExit
With Application
.EnableEvents = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
For Each objSh In ThisWorkbook.Worksheets
On Error Resume Next
Set rngR = objSh.UsedRange.SpecialCells(xlCellTypeConstants)
fehler = Err.Number
On Error GoTo ErrExit
If fehler = 0 Then
For Each rng In rngR
rng = Trim(rng)
Next
Else
MsgBox "Fehler " & fehler & " Blatt " & objSh.Name
End If
Next
ErrExit:
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = lngCalc
End With
Set rng = Nothing
Set rngR = Nothing
Set objSh = Nothing
End Sub

Durch die MsgBox siehst Du, auf welchem Blatt ein "Fehler" auftritt. Letzterer kann aber auch schlicht bedeuten, daß das Blatt leer ist bzw. keine WERTE vorhanden sind.
VIELLEICHT funktioniert der Code nämlich nur scheinbar nicht bei Deiner Original-Datei, dann nämlich, wenn dort NUR Formeln und keine Werte vorhanden sind.
Wenn Du führende Leerzeichen etwa durch =" "&"Bla" erzeugst, können sie nicht ohne Weiteres durch dieses Makro entfernt werden: dann müßte man nämlich die Formeln durch Werte ersetzen.
Schöne Grüße,
Michael

GLÄTTEN für gesamte Arbeitsmappe

Forumthread: GLÄTTEN für gesamte Arbeitsmappe

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial