自定义删掉重复字母只保留一个

数字迷

自定义删掉重复字母只保留一个，要求在表里边，先谢

qline302

Function OnlyOne(Target As Range, Optional Num As Integer = 1)
'自定义函数Onlyone
Dim dic As Object, i%, m$, a$, strOne$

Set dic = CreateObject("Scripting.dictionary")
m = Target.Value
For i = 1 To Len(m)
    a = Mid(m, i, Num)
    If Not dic.exists(a) Then
        dic.Add a, i
        strOne = strOne & a
    End If
Next
OnlyOne = strOne
Set dic = Nothing

End Function

咔咔乱坠

函数，参与一下,两种方法有不同的excel版本要求
方法1=CONCAT(UNIQUE(MID(B1,ROW($1:99),1)))
方法2=字母去重(B1)

ykcbf1100

参与一下。。。

1. Function toone(rng As Range)
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     st = rng.Value
   
4.     For i = 1 To Len(st)
   
5.         s = Mid(st, i, 1)
   
6.         d(s) = s
   
7.     Next
   
8.     toone = Replace(Join(d.keys), " ", "")
   
9.     Set d = Nothing
   
10. End Function
    

复制代码

ykcbf1100

附件供参考。。。

jiangxiaoyun

saghj

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, i&, j&, dic As Object, strKey$
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    For i = 1 To UBound(ar)
        dic.RemoveAll
        For j = 1 To Len(ar(i, 1))
            strKey = Mid(ar(i, 1), j, 1)
            dic(strKey) = Empty
        Next j
        ar(i, 1) = Join(dic.keys, "")
    Next i
   
    Columns("C").Clear
    [C1].Resize(UBound(ar)) = ar
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

参与一下。。。

伊可赛二