Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1844to1848
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
doppelte Werte löschen
27.08.2021 14:12:32
Fred
Hallo zusammen,
ich brauch Hilfe bei einer VBA-Funktion, die mir alle doppelten Werte entfernt.
Aus dieser Zahlenfolge:
000000011000000000110
Soll diese werden:
01010
Ich habe es leider bisher nicht hinbekommen, dies mit anderen Lösungswegen umzusetzen.
Dabei war mein Ziel eine vergleichbare Funktion wie diese zu haben: =doppelteLöschen(A1)
Ich hoffe, dass ihr mir weiter helfen könnt. Vielen Dank schonmal.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: doppelte Werte löschen
27.08.2021 14:34:56
Daniel
Hi
Ungetestet:

Function DoppelteLöschen(txt as String) as String
Dim i as long, T as String
Erg = left(txt, 1)
For i = 2 to len(txt)
T =  mid(txt, i, 1)
If T  right(Erg, 1) then Erg = Erg & T
Next
DoppelteLöschen = Erg
End Funktion
Gruß Daniel
Next
AW: doppelte Werte löschen
27.08.2021 14:36:00
UweD
Hallo
so?

Function doppelteLöschen(TText)
Dim TMP, i As Integer, Anz As Integer
For i = 1 To Len(TText)
TMP = Mid(TText, i, 1)
If TMP = "" Then GoTo fertig
Do
Anz = (Len(TText) - Len(Replace(TText, TMP & TMP, ""))) / 2
TText = Replace(TText, TMP & TMP, TMP)
Loop Until Anz = 0
Next
fertig:
doppelteLöschen = TText
End Function
LG UweD
Anzeige
AW: doppelte Werte löschen
27.08.2021 14:39:49
Fred
Vielen vielen Dank, für die schnellen Antworten. Hat funktioniert und mein Problem gelöst.
Hab wiedermal nicht aktualisiert, aber dennoch...
27.08.2021 14:57:25
migre
Hi,
...hier meine Variante, auch wenn nicht mehr benötigt:

Function RemoveRepeatChar(tCell As Range) As String
Dim i&, s$, c$, d$
c = "": d = ""
For i = 1 To Len(tCell.Text)
With tCell
c = Mid(.Text, i, 1)
Select Case True
Case d = ""
d = c: s = s & c
Case d  ""
Select Case True
Case c = d
s = s
Case c  d
d = c: s = s & c
End Select
End Select
End With
Next i
RemoveRepeatChar = s
End Function
LG Michael

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige