新人在工作中遇到的问题，希望大家给与帮助

pengpeng1989

新建 Microsoft Office Excel 工作表 (2).zip (7.39 KB, 下载次数: 21)

2013-9-16 14:09 上传

点击文件名下载附件
附件

如附件，拿到的表格是城市区号和相对应的号段，需要整理出来，但是很多数据给出的都是范围，我想将712-714这种数据转化成712,713,714,这种数据，再在前边加上他在上边的1846输出到右边，希望各位大牛能给小弟一些指点

老谭酸菜

数据有问题！把原始数据的单元格格式改为“常规”后仔细看看！

jsxjd

纵向扩展，计数就需要不短的公式，还是用VBA

老谭酸菜

代码：
\[code=vb]Sub 数据整理()
    Dim sz, sz1, sz3
   
    Sheets(2).Cells.ClearContents
    Sheets(1).Activate
    n = [VI1].End(xlToLeft).Column
    rng1 = Range(Cells(1, 2), Cells(1, n))   '号段区
    rng2 = Range(Cells(2, 1), Cells([A65536].End(xlUp).Row, 1))   '区号
    rng3 = Range(Cells(2, 2), Cells([A65536].End(xlUp).Row, n))   '尾号区
    n = n - 1
    m = 1
    Sheets(2).Cells(m, 1) = Range("A1")
    Sheets(2).Cells(m, 2) = "号段"
    m = m + 1
    For i1 = 1 To UBound(rng2)         '逐区号循环
        For i2 = 1 To UBound(rng1, 2)    '逐号段循环
            If Len(Trim(rng3(i1, i2))) = 0 Then GoTo out
            If InStr(rng3(i1, i2), ",") > 0 Then
                sz = Split(Replace(rng3(i1, i2), " ", "", 1, -1), ",")
            Else
                ReDim sz(0)
                sz(0) = rng3(i1, i2)
            End If

            For i3 = 0 To UBound(sz)
                If InStr(sz(i3), "-") > 0 Then
                    sz3 = Split(sz(i3), "-")
                    ReDim sz1(CInt(sz3(1)) - CInt(sz3(0)))
                    For i5 = CInt(sz3(0)) To CInt(sz3(1))
                        sz1(i5 - CInt(sz3(0))) = IIf(Len(CStr(i5)) = 3, CStr(i5), IIf(Len(CStr(i5)) = 2, "0" & CStr(i5), "00" & CStr(i5)))
                    Next i5
                Else
                    ReDim sz1(0)
                    sz1(0) = sz(i3)
                End If
               
                For i4 = 0 To UBound(sz1)
                    str1 = rng1(1, i2) & sz1(i4)
                    Sheets(2).Cells(m, 1) = rng2(i1, 1)
                    Sheets(2).Cells(m, 2) = str1
                    m = m + 1
                Next i4
            Next i3
out:
        Next i2
    Next i1
    Sheets(2).Activate
End Sub
[/code]

老谭酸菜

附件：

新建 Microsoft Office Excel 工作表 (2).rar (17.37 KB, 下载次数: 3)

2013-9-16 18:19 上传

点击文件名下载附件

帮你把错误的数据改正了。你数据中那些逗号分隔符是假的！用格式设置出来的。结果放在第二个表里。
文件格式也从“.xlsx”改为“.xlsm”了，否则不支持宏代码！

大灰狼1976

附件请测试，没有遇到格式问题，结果正确
注：结果生成在A21开始的单元格区域

1. Private Sub CommandButton1_Click()
   
2. Dim arr, arr1(1 To 1000, 1 To 2), arr2, i&, j&, k&, l&, s$, m&
   
3. arr = [a1].CurrentRegion
   
4. m = 1
   
5. For i = 2 To UBound(arr)
   
6.   For j = 2 To UBound(arr, 2)
   
7.     If arr(i, j) <> "" Then
   
8.       If InStr(arr(i, j), "-") Then
   
9.         arr2 = Split(arr(i, j), ",")
   
10.         For k = 0 To UBound(arr2)
    
11.           If InStr(arr2(k), "-") Then
    
12.             For l = Split(arr2(k), "-")(0) To Split(arr2(k), "-")(1)
    
13.               s = s & "," & l
    
14.             Next l
    
15.             arr2(k) = Mid(s, 2)
    
16.           End If
    
17.         Next k
    
18.         arr(i, j) = Join(arr2, ",")
    
19.       End If
    
20.     End If
    
21.     arr2 = Split(arr(i, j), ",")
    
22.     For l = 0 To UBound(arr2)
    
23.       arr1(m, 1) = arr(i, 1)
    
24.       arr1(m, 2) = arr(1, j) & arr2(l)
    
25.       m = m + 1
    
26.     Next l
    
27.   Next j
    
28. Next i
    
29. [a21].Resize(UBound(arr1), 2) = arr1
    
30. End Sub
    

复制代码

老谭酸菜

大灰狼1976 发表于 2013-9-16 18:23
附件请测试，没有遇到格式问题，结果正确
注：结果生成在A21开始的单元格区域

呵呵，奇怪了！难道是我的EXCEL有问题？

大灰狼1976

你再下载一个楼主的附件看一下，可能他已经更新过了

老谭酸菜

又试了下，当我双击了数据单元格后，格式就变了，逗号消失！成为千分位的货币格式。看来是我错怪楼主了！

老谭酸菜

大灰狼1976 发表于 2013-9-16 18:23
附件请测试，没有遇到格式问题，结果正确
注：结果生成在A21开始的单元格区域

把B3单元格的数据改为“001-005,717”再运行下看看？