合并数据求助

clyfd

请老师帮忙整理一下数据，就是把F 列的用/隔开的数据，如果头尾相连就合并，不相连就维持原样，并写入G列，谢谢老师的帮助
求助.rar (132.73 KB, 下载次数: 27)

2023-7-4 21:29 上传

点击文件名下载附件

汉唐

文件太大，上传不了，请参考以下代码
Sub 按钮1_Click()
Dim i As Long, x As Long, n As Long, r As Long
Dim arr, a
r = Cells(Rows.Count, 6).End(xlUp).Row
arr = Cells(1, 6).Resize(r, 2)
For i = 2 To UBound(arr)
arr(i, 1) = Replace(arr(i, 1), "/", "/-")
a = Split(arr(i, 1), "-")
For x = 0 To UBound(a) - 1
If Val(a(x)) + 1 = Val(a(x + 1)) Then
n = n + 1
a(x) = Empty
Else
If n > 0 Then
  a(x) = Empty
  n = 0
End If
End If
Next 'x,a
Cells(i, 7) = Empty
For x = 0 To UBound(a)
If a(x) <> Empty Then
If Cells(i, 7) = Empty Then
Cells(i, 7) = a(x)
Else
Cells(i, 7) = Cells(i, 7) & "-" & a(x)
End If
End If
Next 'x
Cells(i, 7) = Replace(Cells(i, 7), "/-", "/")
Next 'i
End Sub

gwjkkkkk

请参考附件。。。

fzxba

1. Sub testArrayList() '参与练习
   
2.   Dim result, ar, br, strData As String
   
3.   Dim i As Long, j As Long, Num As Long
   
4. '  Dim DynamicArray As New ArrayList '引用 mscorlib.dll
   
5.   Dim DynamicArray As Object
   
6.   Set DynamicArray = CreateObject("System.Collections.ArrayList")
   
7.   result = Range("F2", Cells(Rows.Count, "F").End(xlUp))
   
8.   With DynamicArray
   
9.     For i = 1 To UBound(result)
   
10.       strData = Trim(result(i, 1))
    
11.       If Len(strData) Then
    
12.         ar = Split(strData, "/")
    
13.         For j = 0 To UBound(ar)
    
14.           br = Split(ar(j), "-")
    
15.           For Num = Val(br(0)) To Val(br(UBound(br)))
    
16.             .Add Num
    
17.           Next
    
18.         Next
    
19.         .Sort
    
20.         br = .ToArray
    
21.         result(i, 1) = br(LBound(br)) & "-"
    
22.         For j = LBound(br) + 1 To UBound(br)
    
23.           If j < UBound(br) Then
    
24.             If br(j) - br(j - 1) <> 1 Then result(i, 1) = result(i, 1) & br(j - 1) & "/" & br(j) & "-"
    
25.           Else
    
26.             result(i, 1) = result(i, 1) & br(j)
    
27.           End If
    
28.         Next
    
29.       End If
    
30.       .Clear
    
31.     Next
    
32.   End With
    
33.   Range("H2").Resize(UBound(result), 1) = result
    
34.   Set DynamicArray = Nothing
    
35.   Beep
    
36. End Sub

复制代码

sdytsxd991122

参与一下