[已解决]引用另一工作表的数据如何分列？

ayfbb

新手求助，希望帮忙解答，万分感谢！
要求：
1、表111中B列数据引用自表222的A列，如何用公式或VBA拆分表111中B列数据（表111中B列显示公式，数据分列功能不能用）。
2、表111中B列数要拆分为如上所示的固定格式，“.”相连的数据最多5个，不足5个拆分时留空(因此它需要占据固定5个位置，不足五个留空)，“-”相连的800之类的数据必须放置在客户编码此列，“+”相连的900的数据必须放置在物流编码此列!

最佳答案

月排行榜 / 总排行榜

cbg2008

2013-3-6 14:09

引用数据固定分列_20130306.rar (19.79 KB, 下载次数: 14)

2013-3-6 14:09 上传

点击文件名下载附件

跳转到最佳答案楼层

ayfbb

求助，不知道怎么处理啊！

hwc2ycy

等CBG2008,zdjh来回贴，
还有那么的帅。

hwc2ycy

1. Sub 拆分()
   
2.     Dim arr, arrTemp, key As String
   
3.     Dim i As Long
   
4.    
   
5.     arr = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row)
   
6.     Dim arrResult()
   
7.     ReDim arrResult(1 To UBound(arr), 1 To 7)
   
8.     For i = LBound(arr) To UBound(arr)
   
9.         key = Replace(arr(i, 1), ".", "-")
   
10.         key = Replace(key, "+", "-")
    
11.         arrTemp = Split(key, "-")
    
12. 
    
13.         arrResult(i, 1) = arrTemp(0)
    
14. 
    
15.         Select Case UBound(arrTemp)
    
16.         Case 1
    
17.             arrResult(i, 6) = arrTemp(1)
    
18.         Case 2
    
19.             arrResult(i, 6) = arrTemp(1)
    
20.             arrResult(i, 7) = arrTemp(2)
    
21.         Case 3
    
22.             arrResult(i, 2) = arrTemp(1)
    
23.             arrResult(i, 6) = arrTemp(2)
    
24.             arrResult(i, 7) = arrTemp(3)
    
25. 
    
26.         Case 4
    
27.             arrResult(i, 2) = arrTemp(1)
    
28.             arrResult(i, 3) = arrTemp(2)
    
29.             arrResult(i, 6) = arrTemp(3)
    
30.             arrResult(i, 7) = arrTemp(4)
    
31.         Case 5
    
32.             arrResult(i, 2) = arrTemp(1)
    
33.             arrResult(i, 3) = arrTemp(2)
    
34.             arrResult(i, 4) = arrTemp(3)
    
35.             arrResult(i, 6) = arrTemp(4)
    
36.             arrResult(i, 7) = arrTemp(5)
    
37. 
    
38.         Case 6
    
39.             arrResult(i, 2) = arrTemp(1)
    
40.             arrResult(i, 3) = arrTemp(2)
    
41.             arrResult(i, 4) = arrTemp(3)
    
42.             arrResult(i, 5) = arrTemp(4)
    
43.             arrResult(i, 6) = arrTemp(5)
    
44.             arrResult(i, 7) = arrTemp(6)
    
45.         End Select
    
46.     Next
    
47.     Range("c3").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
    
48. End Sub

复制代码

hwc2ycy

1. Sub 拆分()
   
2.     Dim arr, arrTemp, key As String
   
3.     Dim i As Long, j As Byte, k As Byte
   
4. 
   
5.     If Cells(Rows.Count, 2).End(xlUp).Row < 4 Then Exit Sub
   
6. 
   
7.     arr = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row)
   
8.     Dim arrResult()
   
9.     ReDim arrResult(1 To UBound(arr), 1 To 7)
   
10.     Dim arrPos1, arrPos2
    
11.     arrPos1 = Array(Array(1, 6), Array(1, 6, 7), Array(1, 2, 6, 7), Array(1, 2, 3, 6, 7), Array(1, 2, 3, 4, 6, 7), Array(1, 2, 3, 4, 5, 6, 7))
    
12.     arrPos2 = Array(Array(0, 1), Array(0, 1, 2), Array(0, 1, 2, 3), Array(0, 1, 2, 3, 4), Array(0, 1, 2, 3, 4, 5), Array(0, 1, 2, 3, 4, 5, 6))
    
13.    
    
14.     For i = LBound(arr) To UBound(arr)
    
15.         key = Replace(arr(i, 1), ".", "-")
    
16.         key = Replace(key, "+", "-")
    
17.         arrTemp = Split(key, "-")
    
18.         
    
19.         j = UBound(arrTemp) - 1
    
20.         For k = LBound(arrPos1(j)) To UBound(arrPos1(j))
    
21.             arrResult(i, arrPos1(j)(k)) = arrTemp(arrPos2(j)(k))
    
22.         Next
    
23.     Next
    
24.     Range("c3").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
    
25. End Sub

复制代码

cbg2008

引用数据固定分列_20130306.rar (19.79 KB, 下载次数: 14)

2013-3-6 14:09 上传

点击文件名下载附件

hwc2ycy

1. Sub 拆分()
   
2. '---------------------------------------------------------------------------------------
   
3. ' Procedure : 拆分
   
4. ' Author    : hwc2ycy
   
5. ' Date      : 2013/3/6
   
6. ' Purpose   : 数组嵌套+坐标对应
   
7. '---------------------------------------------------------------------------------------
   
8. '
   
9.     Dim arr, arrTemp, key As String
   
10.     Dim i As Long, j As Byte, k As Byte
    
11. 
    
12.     '防止没有任何数据行
    
13.     If Cells(Rows.Count, 2).End(xlUp).Row < 4 Then Exit Sub
    
14. 
    
15.     '取源数据
    
16.     arr = Range("b3:c" & Cells(Rows.Count, 2).End(xlUp).Row)
    
17.    
    
18.     '结果数组
    
19.     Dim arrResult()
    
20.     ReDim arrResult(1 To UBound(arr), 1 To 7)
    
21.    
    
22.     '对应的坐标位置
    
23.     'arrPos1是结果的列坐标
    
24.     'arrPos2是源数组的列坐标
    
25.     Dim arrPos1, arrPos2
    
26.     arrPos1 = Array(Array(1, 6), Array(1, 6, 7), Array(1, 2, 6, 7), Array(1, 2, 3, 6, 7), Array(1, 2, 3, 4, 6, 7), Array(1, 2, 3, 4, 5, 6, 7))
    
27.     arrPos2 = Array(Array(0, 1), Array(0, 1, 2), Array(0, 1, 2, 3), Array(0, 1, 2, 3, 4), Array(0, 1, 2, 3, 4, 5), Array(0, 1, 2, 3, 4, 5, 6))
    
28.    
    
29.     '遍历数组
    
30.     For i = LBound(arr) To UBound(arr)
    
31.         '替换,+
    
32.         key = Replace(arr(i, 1), ".", "-")
    
33.         key = Replace(key, "+", "-")
    
34.         '防止没有合乎要求的数据
    
35.         If arrTemp Like "*-*" Then
    
36.             arrTemp = Split(key, "-")
    
37.             j = UBound(arrTemp) - 1
    
38.             '按坐标对应关系写入数组,用了数组嵌套
    
39.             For k = LBound(arrPos1(j)) To UBound(arrPos1(j))
    
40.                 arrResult(i, arrPos1(j)(k)) = arrTemp(arrPos2(j)(k))
    
41.             Next
    
42.         End If
    
43.         
    
44.     Next
    
45.     '结果写回单元格
    
46.     Range("c3").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
    
47.     MsgBox "整理完成"
    
48. End Sub
    

复制代码

ayfbb

cbg2008 发表于 2013-3-6 14:09

非常感谢，公式很好用。数据拆分后位置定位很好，-800数据没有的话+900类的数据依然在固定位置出现。感谢...

爱疯

替楼主评了。
希望楼主下次自己学习评最佳

ayfbb

看到如何选评最佳了