合并连续的序号

xgluo

用符号"-"合并有相同前缀且连续序号超过3（含3）的字符串，每个单元格可能存在多种前缀，因此合并前需要对单元格进行排序，合并后的数据仍存放于H列，祥见附件。

duquancai

手机ing，很难吗？

excelvlookup

是每一行做一个连号，还是全表做一个连号？

xgluo

excelvlookup 发表于 2020-5-28 21:57
是每一行做一个连号，还是全表做一个连号？

每行一个！

deadzlq

PowerQuery参考解法

一把小刀闯天下

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.   Dim arr, i, j, k, s, ss, t, p, pp, mark
   
5.   mark = ".0123456789"
   
6.   arr = Range("h10:h" & Cells(Rows.Count, "h").End(xlUp).Row).Value
   
7.   For i = 1 To UBound(arr, 1)
   
8.     t = Split(Replace(arr(i, 1), Space(1), vbNullString), ",")
   
9.     ReDim brr(1 To UBound(t) + 2, 1 To 3)
   
10.     For j = 0 To UBound(t)
    
11.       For k = Len(t(j)) To 1 Step -1
    
12.         If InStr(mark, Mid(t(j), k, 1)) = 0 Then
    
13.           brr(j + 1, 1) = t(j)
    
14.           brr(j + 1, 2) = left(t(j), k)
    
15.           brr(j + 1, 3) = Val(Mid(t(j), k + 1))
    
16.           Exit For
    
17.         End If
    
18.       Next
    
19.     Next
    
20.     Call bsort(brr, 1, UBound(brr, 1) - 1, 1, UBound(brr, 2), 2)
    
21.     For j = 1 To UBound(brr) - 1
    
22.       If brr(j, 2) <> brr(j + 1, 2) Then
    
23.         Call bsort(brr, p + 1, j, 1, UBound(brr, 2), 3)
    
24.         pp = p + 1
    
25.         For k = p + 2 To j + 1
    
26.           If brr(k, 3) - brr(k - 1, 3) <> 1 Then
    
27.             If k - pp > 1 Then ss = "-" & brr(k - 1, 1) Else ss = vbNullString
    
28.             s = s & "," & brr(pp, 1) & ss
    
29.             pp = k
    
30.           End If
    
31.         Next
    
32.         p = j
    
33.       End If
    
34.     Next
    
35.     arr(i, 1) = Mid(s, 2): p = 0: s = vbNullString
    
36.   Next
    
37.   [i10].Resize(UBound(arr, 1)) = arr
    
38. End Sub
    
39. 
    
40. Function bsort(arr, first, last, left, right, key)
    
41.   Dim i, j, k, t
    
42.   For i = first To last - 1
    
43.     For j = first To last + first - 1 - i
    
44.       If arr(j, key) > arr(j + 1, key) Then
    
45.         For k = left To right
    
46.           t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
    
47.         Next
    
48.       End If
    
49.     Next
    
50.   Next
    
51. End Function

复制代码

xgluo

一把小刀闯天下 发表于 2020-5-29 12:25

是这个意思，但是只有连续数字超过3个（包含3）以上的才进行合并，如 R1,R2,R3合并成R1-R3,但连续两个的不需要合并：如R1,R2。能麻烦帮忙改改，谢谢！

renkangjizhen

难度、麻烦度都很高

excelvlookup

试试是否合适

xgluo

excelvlookup 发表于 2020-5-30 23:50
试试是否合适

非常棒！！正是希望的！！！