【函数小题】字符串去重及压缩

静听溪流

cutecpu 发表于 2020-6-9 02:11
去重: =CONCAT(MID(A3,IF(MID(A3,ROW($1:$11),1)MID(A3,ROW($2:$12),1),ROW($1:$11),12),1))

压缩:

第二个的公式有点小瑕疵，当某个字母连续10个的时候会出现错误。如AAAAAAAAAAB，公式会显示为A1B1

静听溪流

丢丢表格 发表于 2020-6-9 12:36
你的思路很好，就是公式的通用性差一点。。。

=CONCAT(IF(MID(A3,ROW($1:21),1)=MID(A3,ROW($2:22),1) ...

=CONCAT(IF(MID(A3,ROW($1:21),1)=MID(A3,ROW($2:22),1),"",MID(A3,ROW($1:21),1)&FREQUENCY(ROW($1:20),IF(MID(A3,ROW($1:20),1)=MID(A3,ROW($2:21),1),0,ROW($1:20)))))
我测试的时候需要增加"",不然就会出现很多个0

象山海鲜

丢丢表格 发表于 2020-6-9 13:59
WPS

是有差别的？。

他要求的是11字符....
老师的字符串是10字符

字符长度 1~98个可用

1. =CONCAT(TEXT(-FREQUENCY(ROW(INDIRECT("1:"&LEN(A3))),(MID(A3,ROW($1:$98),1)<>MID(A3,ROW($2:$99),1))*ROW($1:$98)),";!"&MID(A3,ROW($1:$99),1)&0))

复制代码

静听溪流

每次发帖，收获都比较多
贴一下我的公式：
第一个问题：=concat(FILTERXML("<a><b>"&TEXTJOIN("</b><b>",,MID(A3&1,ROW($1:$12),1))&"</b></a>","a/b[not (contains(.,following::b[1]))]"))
第二个问题：
=concat(IFERROR(FILTERXML("<a><b>"&TEXTJOIN("</b><b>",,MID(A3&1,ROW($1:$12),1))&"</b></a>","a/b[not (contains(.,following::b[1]))]")&FREQUENCY(ROW($1:$11),IF(MID(A3,ROW($1:$11),1)=MID(A3,ROW($2:$12),1),"",ROW($1:$11))),""))

静听溪流

dim麻辣君 发表于 2020-6-9 14:41
这样不难啊，替换一下1不就完事

不能简单的替换1，如果有联系10个的字符的话，就会出现问题了

dim麻辣君

静听溪流 发表于 2020-6-9 17:11
不能简单的替换1，如果有联系10个的字符的话，就会出现问题了

对哦，还要考虑10以上，又长见识了，多谢

LWQ张无忌

去重先上，有点长
=CONCAT(IFERROR(MID(A3,(1-FREQUENCY(IFERROR(FIND(REPT(CHAR(ROW($65:$90)),COLUMN(B:L)),A3)+COLUMN(A:K)-1,""),ROW($1:11)))*ROW($1:11),1),""))
第二个，只能抄了
=CONCAT(IFERROR(MID(A3,IF(MID(A3,ROW($1:11),1)<>MID(A3,ROW($2:12),1),ROW($1:11)),1)&FREQUENCY(ROW($1:11),((MID(A3,ROW($1:11),1)<>MID(A3,ROW($2:12),1))*ROW($1:11))),""))

1055751654

shss12 发表于 2020-6-9 09:48
去重 数组  这个用函数有点没头绪，用了最笨的火车法，那个压缩加数字的这个火车法就不能用了，公式超长了 ...

代码都没你的函数长
Sub kk()
Dim regex As Object, rg As Range, aa, aaa, TT$
Set regex = CreateObject("VBSCRIPT.REGEXP")
Range("F3:G5").ClearContents
With regex
    For Each rg In Range("e3:e" & Cells(Rows.Count, "e").End(xlUp).Row)
        .Global = 1
        .IgnoreCase = 1
            .Pattern = "([a-z])\1+|([a-z]){1}"
                Set aaa = .Execute(rg)
                    For Each aa In aaa
                    If Len(aa) > 1 Then
                    TT = .Replace(aa, "$1")
                Else
            TT = aa.Value
        End If
    Cells(rg.Row, "F").Value = Cells(rg.Row, "F").Value & TT
Cells(rg.Row, "G").Value = Cells(rg.Row, "G").Value & IIf(Len(aa) = 1, aa.Value, .Replace(aa, "$1")) & Len(aa)
Next
Next
End With
End Sub

LWQ张无忌

象山海鲜 发表于 2020-6-9 13:30
不想开火车，只有高版本才好

增加难度，这样大家练习下

ggmmlol

1055751654 发表于 2020-6-9 20:05
代码都没你的函数长
Sub kk()
Dim regex As Object, rg As Range, aa, aaa, TT$

如果用正则，可以用同一个正则表达式完成去重、压缩。
其中，解决“压缩”的问题，可以用正则的Replace方法构造公式来实现。

1. Sub ggmmlol()
   
2.     Set reg = CreateObject("VBScript.RegExp")
   
3.     reg.Global = True
   
4.     reg.Pattern = "(.)(\1*)"
   
5.     ar = Range("A1").CurrentRegion.Resize(, 2).Offset(2)
   
6.     r = UBound(ar)
   
7.     For i = 1 To r - 1
   
8.         ar(i, 2) = "=""" & reg.Replace(ar(i, 1), "$1""&len(""$1$2"")&""") & """"
   
9.         ar(i, 1) = reg.Replace(ar(i, 1), "$1")
   
10.     Next
    
11.     Range("B3").Resize(r - 1, 2).NumberFormat = ""
    
12.     Range("B3").Resize(r - 1, 2).Value = ar
    
13. End Sub

复制代码