EXCEL单元格中1-3,5,7-9怎么转换成1,2,3,5,7,8,9

ldsamoy

如题，某些系统导出的数据会把顺序的数字合并成1-3模式，代表1，2，3。混合在一起很难处理，如何把1-3,5,7-9这样的数据批量写成逗号分隔的模式：1,2,3,5,7,8,9。

请大神指教。


如附件表格中原始数据转换为目标数据

liulang0808

论坛里应该有雷同的问题，楼主检索下
如果还有问题，建议上传附件

fzxba

1. Sub test0()
   
2.   Dim ar, br, cr, i&, j&, k&, s$
   
3.   ar = Range("A1").CurrentRegion.Resize(, 2)
   
4.   For i = 2 To UBound(ar)
   
5.     s = vbNullString
   
6.     br = Split(ar(i, 1), ",")
   
7.     For j = 0 To UBound(br)
   
8.       cr = Split(br(j), "-")
   
9.       For k = cr(0) To cr(UBound(cr))
   
10.         s = s & "," & k
    
11.       Next
    
12.     Next
    
13.     ar(i, 2) = Mid(s, 2)
    
14.   Next
    
15.   Range("A1").CurrentRegion.Resize(, 2) = ar
    
16. End Sub

复制代码

3190496160

Sub 整理()
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r = 1 Then MsgBox "数据源为空": End
    .Range("b2:b" & r) = Empty
    ar = .Range("a1:b" & r)
    For i = 2 To UBound(ar)
        zf = ""
        If Trim(ar(i, 1)) <> "" Then
            If InStr(ar(i, 1), ",") = 0 And InStr(ar(i, 1), "-") = 0 Then
                ar(i, 2) = ar(i, 1)
            Else
                If InStr(ar(i, 1), ",") > 0 Then
                    rr = Split(ar(i, 1), ",")
                    For s = 0 To UBound(rr)
                        If Trim(rr(s)) <> "" Then
                            If InStr(rr(s), "-") = 0 Then
                                If zf = "" Then
                                    zf = rr(s)
                                Else
                                    zf = zf & "," & rr(s)
                                End If
                            Else
                                ks = Val(Split(rr(s), "-")(0))
                                js = Val(Split(rr(s), "-")(1))
                                For j = ks To js
                                    If zf = "" Then
                                        zf = j
                                    Else
                                        zf = zf & "," & j
                                    End If
                                Next j
                            End If
                        End If
                    Next s
                End If
            End If
            ar(i, 2) = zf
        End If
    Next i
    .Range("a1:b" & r) = ar
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

工作簿1.rar (14.79 KB, 下载次数: 14)

2023-1-20 17:35 上传

点击文件名下载附件

明天会更好zj

Sub tt()
Dim str
Dim i, j, x, n
Dim brr(1 To 10000, 1 To 1)
For i = 2 To [a65536].End(3).Row
    arr = Split(Cells(i, 1), ",")
        n = 1
        For j = 0 To UBound(arr)
            If arr(j) Like "*-*" Then
                For x = Split(arr(j), "-")(0) To Split(arr(j), "-")(1)
                   str = str & "," & x
                Next
            Else
              str = str & "," & arr(j)
            End If
        Next
        Cells(i, 2) = Mid(str, 2)
        str = ""
Next
End Sub

陆离Lowry

陆离Lowry

。。。。。。。。。。。。

aman1516

做成自定义函数吧，这种数据格式应用还是挺多的：

1. Sub NumOrder()
   
2. Dim Arr, r&, i&, j&, p$
   
3. r = [a6536].End(xlUp).Row
   
4. Range("B2:B" & r).ClearContents: Arr = Range("A1:B" & r)
   
5. For i = 2 To UBound(Arr)
   
6.     If Arr(i, 1) <> "" Then
   
7.        p = Arr(i, 1)
   
8.        Arr(i, 2) = Porder(p)
   
9.     End If
   
10. Next
    
11. Range("A1").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    
12. End Sub
    
13. 
    
14. Public Function Porder(p As String) As String
    
15.     Dim t&, Sr, s&, ps$
    
16.     p = Replace(p, " ", ""): p = Replace(p, "，", ","): p = Replace(p, "－", "-")    '容错：有空格、大写统一转小写′
    
17.     If InStr(p, ",") = 0 Then p = p & ","
    
18.     Sr = Split(p, ",")
    
19.     For s = 0 To UBound(Sr)
    
20.         If InStr(Sr(s), "-") Then
    
21.            For t = Val(Split(Sr(s), "-")(0)) To Val(Split(Sr(s), "-")(1))
    
22.                If ps = "" Then ps = t Else ps = ps & "," & t
    
23.            Next
    
24.         Else
    
25.            If ps = "" Then ps = Sr(s) Else ps = ps & "," & Sr(s)
    
26.         End If
    
27.     Next
    
28.     Porder = ps
    
29. End Function

复制代码