[已解决]没有规律的数字分划？

天空的雨

您好：这杂乱的数据，不晓得用VBA能否做到分门别类？详见附件 出货部接货费.rar (9.77 KB, 下载次数: 11)

2014-5-16 16:06 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-16 17:52

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%
   
3. w = Array("、", "，")
   
4. For i = 0 To UBound(w)
   
5. [a2:c11].Replace w(i), ""
   
6. Next
   
7. arr = [a2:c11]
   
8. ReDim brr(1 To UBound(arr), 1 To 1)
   
9. For i = 1 To UBound(arr)
   
10.     If arr(i, 1) <> arr(i, 2) Then
    
11.         x = Split(arr(i, 3))
    
12.         For j = 0 To UBound(x)
    
13.             If x(j) Like "*票?车" Then arr(i, 3) = Replace(arr(i, 3), x(j), "")
    
14.             If x(j) Like "*#*" Then
    
15.                 brr(i, 1) = IIf(brr(i, 1) = "", x(j), brr(i, 1) & " " & x(j))
    
16.                 arr(i, 2) = arr(i, 2) + Val(Mid(x(j), 2)): arr(i, 3) = Replace(arr(i, 3), x(j), "")
    
17.             End If
    
18.         Next
    
19.     End If
    
20. Next
    
21. For i = 1 To UBound(arr)
    
22.     If arr(i, 1) <> arr(i, 2) Then
    
23.         x = Split(Trim(arr(i, 3)))
    
24.         y = UBound(x) + 1
    
25.         n = (arr(i, 1) - arr(i, 2)) / y
    
26.         For j = 0 To UBound(x)
    
27.             brr(i, 1) = brr(i, 1) & " " & x(j) & n
    
28.         Next
    
29.     End If
    
30. Next
    
31. Range("d2").Resize(UBound(brr)) = brr
    
32. End Sub
    

复制代码

dsmch

………………

天空的雨

dsmch 发表于 2014-5-16 17:52
………………

写入数组，不断的替换。如果备注栏内有三个以上的姓会出错？
例：单元格C8内容为：魏，徐， 老徐80
单元格D8出来的结果是：老徐80 魏，徐，200
正确的结果应该是：老徐80 魏100，徐100，

也怪我，数据列举不完。代码应该如何改动呢？
你代码中有很多的处理办法，也许答案就在里面。谢谢你！