GLÄTTEN funktioniert nicht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hat, habe ich inzwischen mal umgesetzt:

Rem Reduziert Texte um alle Zeichen (außer Ziffern),
'   die keine Groß/Klein-Varianten haben, sofern sie
'   nicht unter Arg3 aufgeführt wdn, bzw ersetzt sie
'   (auch ZchFolgen) durch 1 einzelnes Zchn lt Arg2,
'   am TextAnfang u. -ende entfallen sie aber stets;
'   Arg1 kann auch ein Bereich or Datenfeld (ggf aus
'   Ausdruck) sein (zell/elementweise Verarbeitung).
'   Hinws: In Arg3 kombind diakritZch separat angeb!
'   Vs1.0 -LSr -cd:20190828 -1pub: 20190828h -lupd:20190828t

Function Reduce(Bezug, Optional ByVal ErsatzZ$ = "", Optional ByVal Ausnahmen$) Const permAusn$ = "0123456789ß" Dim pos As Long, sic As Long, six As Long, zic As Long, zix As Long, _ ersZ$(1), pZn$(1), bez, erg On Error Resume Next Ausnahmen = Ausnahmen & permAusn: ersZ(1) = Left(ErsatzZ, 1) If TypeOf Bezug Is Range Then zic = Bezug.Rows.Count: sic = Bezug.Columns.Count ElseIf IsError(LBound(Bezug, 2)) Then sic = UBound(Bezug) + 1 - LBound(Bezug): zic = 1 Else: zic = UBound(Bezug, 1) + 1 - LBound(Bezug, 1) sic = UBound(Bezug, 2) + 1 - LBound(Bezug, 2) End If ReDim erg(zic - 1, sic - 1) For Each bez In Bezug pos = 1 If Not (IsError(bez) Or IsNumeric(bez)) Then Do: pZn(1) = Mid(bez, pos, 1) If InStr(Ausnahmen, pZn(1)) = 0 Or _ (pZn(1) = pZn(0) And Not IsNumeric(pZn(1))) Then If UCase(pZn(1)) = LCase(pZn(1)) Then ersZ(0) = IIf(ersZ(1) = pZn(0) Or pos = 1 Or _ pos = Len(bez), "", ersZ(1)) bez = Left(bez, pos - 1) & ersZ(0) & Mid(bez, pos + 1) pos = pos + CInt(ersZ(0) = "") pZn(1) = IIf(ersZ(1) = "", pZn(1), ersZ(1)) End If End If pos = pos + 1: pZn(0) = pZn(1) Loop Until pos > Len(bez) erg(zix, six) = bez If TypeOf Bezug Is Range Then six = (six + 1) Mod sic: zix = (zix - CInt(six = 0)) Mod zic Else: zix = (zix + 1) Mod zic: six = (six - CInt(zix = 0)) Mod sic End If End If Next bez Reduce = erg End Function Diese UDF kann bspw wie folgt angewendet wdn:
1. Einzelzellen:
=Reduce(B1)
=Reduce(B1;"-")
=Reduce(B1;;" ")
=Reduce(B1;;"% ")
2. ZellBereiche (plurale MatrixFml):
{=Reduce(A16:B18)}
3. Datenfelder (plurale MatrixFml):
{=Reduce(""&A16:B18;"-";"̆")}
Die letzten beiden natürlich auch mit allen Argumentierungsmöglichkeiten (wie die erste).
Anmerk: Texte in Alfabeten, die den Unterschied GBst:KBst nicht kennen, lassen sich so nicht verarbeiten. Ansonsten wdn aber alle Buchstaben* standardmäßig als solche erkannt, nur buchstabenähnliche Zeichen nicht, da bei diesen kein Umwandlungsvgl möglich ist, was auch für ß gilt, weshalb es, wie auch die 10 StandardZiffern, automatisch den Ausnahmen hinzugefügt wird. Andere Ziffern müssen explizit in Arg3 angegeben wdn, falls sie beizubehalten sind.
* Die entsprd Xl-Fktt erkennen nicht alle (historischen) Unicode-Buchstaben als solche.
Luc :-?

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

GLÄTTEN funktioniert nicht

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread