[已解决]单元格内多机构改为分别单行显示问题

richalken

我的数据中某一个单元格中有多个机构，我希望将不同的结构分别改为单行显示，请大侠帮忙。谢谢啦！！！{:041:}

最佳答案

月排行榜 / 总排行榜

hysys32

2015-10-21 21:18

richalken 发表于 2015-10-21 21:04
自己顶一下，希望有大侠路过出手相助

Sub test()
    Dim arr, arrTmp
    Dim rarr(1 To 100000, 1 To 5)
    Dim i As Long
    Dim k As Long
    Dim j As Long
    arr = Sheet1.Range("a1").CurrentRegion
    For i = 1 To UBound(arr)
       If VBA.InStr(1, arr(i, 5), "/") Then
           arrTmp = Split(arr(i, 5), "/")
           For j = 0 To UBound(arrTmp)
               k = k + 1
               For c = 1 To 4
                    rarr(k, c) = arr(i, c)
               Next
               rarr(k, 5) = arrTmp(j)
           Next
       Else
             k = k + 1
             For c = 1 To 5
                    rarr(k, c) = arr(i, c)
               Next
       End If
    Next
    Sheet2.Cells.Clear
    Sheet2.Range("a1").Resize(k, 5) = rarr
End Sub
单行显示.rar (16.74 KB, 下载次数: 8)

2015-10-21 21:21 上传

点击文件名下载附件

跳转到最佳答案楼层

richalken

自己顶一下，希望有大侠路过出手相助{:091:}{:091:}{:091:}

hysys32

richalken 发表于 2015-10-21 21:04
自己顶一下，希望有大侠路过出手相助

Sub test()
    Dim arr, arrTmp
    Dim rarr(1 To 100000, 1 To 5)
    Dim i As Long
    Dim k As Long
    Dim j As Long
    arr = Sheet1.Range("a1").CurrentRegion
    For i = 1 To UBound(arr)
       If VBA.InStr(1, arr(i, 5), "/") Then
           arrTmp = Split(arr(i, 5), "/")
           For j = 0 To UBound(arrTmp)
               k = k + 1
               For c = 1 To 4
                    rarr(k, c) = arr(i, c)
               Next
               rarr(k, 5) = arrTmp(j)
           Next
       Else
             k = k + 1
             For c = 1 To 5
                    rarr(k, c) = arr(i, c)
               Next
       End If
    Next
    Sheet2.Cells.Clear
    Sheet2.Range("a1").Resize(k, 5) = rarr
End Sub
单行显示.rar (16.74 KB, 下载次数: 8)

2015-10-21 21:21 上传

点击文件名下载附件

richalken

hysys32 发表于 2015-10-21 21:18
Sub test()
    Dim arr, arrTmp
    Dim rarr(1 To 100000, 1 To 5)

大侠太有效率了，赞！！！{:35:}{:35:}

不过有个小问题，在“代码”字段中，我有数据是0开头的（如000233,004765,000087）等，运行后前面的0都木有了（我把字段类型设置成 字符 也么有效果），手动加工作量太大了，大侠可以改进一下吗？{:06:}

richalken

hysys32 发表于 2015-10-21 21:18
Sub test()
    Dim arr, arrTmp
    Dim rarr(1 To 100000, 1 To 5)

自己补好了，使用excel自定义的格式，多谢大侠。