求按姓名合并数据？（等待解决）

追着去学习

合并数据.rar (325.03 KB, 下载次数: 42)

2014-8-30 22:57 上传

点击文件名下载附件

dwjb

vlookup,
hlookup,
精确查找后，if判断下合并“ &,”

蓝桥玄霜

1. Private Sub CommandButton1_Click()
   
2. Dim Arr, i&, aa, x$, y$, Myr&, Brr, Arr1
   
3. Dim d, k, t, tt
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Sheet1.Activate
   
6. Myr = Cells(Rows.Count, 1).End(xlUp).Row
   
7. Range("k7:bt" & Myr).ClearContents
   
8. x = 年份.Text & "|" & 月份.Text
   
9. Arr = Sheet2.UsedRange
   
10. For i = 5 To UBound(Arr)
    
11.     If Arr(i, 1) <> "" Then
    
12.         If InStr(Arr(i, 1), "、") Then
    
13.             aa = Split(Arr(i, 1), "、")
    
14.             x = aa(1) & "|" & aa(2): y = Arr(i, 2)
    
15.             If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
    
16.             d(x)(y) = d(x)(y) & i & ","
    
17.         End If
    
18.     End If
    
19. Next
    
20. k = d.keys: t = d.items
    
21. Arr1 = Range("a7:b" & Myr)
    
22. Brr = Range("k7:bt" & Myr)
    
23. If d.exists(x) Then
    
24.     For i = 1 To UBound(Arr1) Step 2
    
25.         y = Arr1(i, 2)
    
26.         If d(x).exists(y) Then
    
27.             tt = d(x)(y)
    
28.             tt = Left(tt, Len(tt) - 1)
    
29.             If InStr(tt, ",") Then
    
30.                 aa = Split(tt, ",")
    
31.                 For j = 0 To UBound(aa)
    
32.                     For ii = 5 To 66 Step 2
    
33.                         If Arr(aa(j), ii) <> "" Then
    
34.                             If Arr(aa(j), ii) = "半" Then
    
35.                                 If Brr(i, ii - 4) = "半" Then
    
36.                                     Brr(i, ii - 4) = "全"
    
37.                                 Else
    
38.                                     Brr(i, ii - 4) = "半"
    
39.                                 End If
    
40.                             Else
    
41.                                 Brr(i, ii - 4) = "全"
    
42.                             End If
    
43.                             Brr(i + 1, ii - 4) = Brr(i + 1, ii - 4) + Arr(aa(j) + 1, ii)
    
44.                         End If
    
45.                     Next
    
46.                 Next
    
47.             Else
    
48.                     For ii = 5 To 66 Step 2
    
49.                         If Arr(tt, ii) <> "" Then
    
50.                             If Arr(tt, ii) = "半" Then
    
51.                                 Brr(i, ii - 4) = "半"
    
52.                             Else
    
53.                                 Brr(i, ii - 4) = "全"
    
54.                             End If
    
55.                             Brr(i + 1, ii - 4) = Arr(tt + 1, ii)
    
56.                         End If
    
57.                     Next
    
58.             End If
    
59.         End If
    
60.     Next
    
61. End If
    
62. [k7].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
63. End Sub
    

复制代码

蓝桥玄霜

请见附件。

追着去学习

蓝老师：试用后出现不了我希望的结果，请帮忙再看看，谢谢！ 合并数据1.rar (349.95 KB, 下载次数: 13)

2014-8-31 22:21 上传

点击文件名下载附件

           在Sheet3有我希望的结果。
           加一句，金额为0值的不要显示出来。

追着去学习

蓝老师：我本来帐号是“我爱你！”的，但是由于一直用QQ关联登录论坛，密码忘记了，修改不了邮箱。请问还有别方法修改密码吗？

追着去学习

大哥大姐进来看看。

追着去学习

高手老师进来看看5楼的附件，感谢不尽！

KCFONG

see if help you

追着去学习

KCFONG 老师！先谢谢你。
还有下面问题未能解决，附件Sheet3的例表没有表达好，如Y17中的5，BA列中绿色数字。
1、有两个是"半"，合并为一个“全”了，实现了。但是如果是数字，就不要合并为"全"了，把它们相加求和？如Sheet3绿色部分。
2、同一姓名，在同一月份的白天列只有出现两个“半”,数字或一个“全”，如果是数字，求和就可能会得出24，当然是最大的了，晚上的列也是一样。所以当出现两个"半"时，就合并为“全”，一个半，就为半，一个全，就为全，如果是数字就求和？（这里指定是没有合并的单元格，合并的单元格另求和，已解决了）