前面一节我们讲了如果一个key对应的item不止一个数据，可以用条目数组的方法，把几个数据联合在一起写入item，那如果是key的值不止一个该怎么办呢？
如下：
把姓名写入key，因为结果需要保留重复姓名所以肯定不能直接把姓名写入key，如果能把姓名和星期合并起来写入key，把上班时间写入item，这样就不会有重复了。
可是key的值不能这样写：
key(array(a1,a2,a3))=……
所以我们只能另想办法，如果把姓名和星期直接连接在一起，那肯定是可以写入的，为了后面分离的时候方便，我们可以在姓名和星期之间加一个逗号。
代码1：
Sub 格式转化()
Dim d As Object, arr1, arr2, i%, j%, xx, n%
Set d = CreateObject('scripting.dictionary')
arr1 = Range('a2', [h2].End(xlDown))
arr2 = [b1:h1]
For i = 1 To UBound(arr1)
For j = 1 To UBound(arr1, 2) - 1 '或者直接写6
d(arr1(i, 1) & ',' & arr2(1, j)) = Array(arr1(i, j 1)) '把名字和星期合并写入key
Next
Next
xx = d.Keys
For n = 0 To d.Count - 1
Cells(n 2, 'j').Resize(1, 2) = Split(xx(n), ',') '把key拆分出来放入相应的位置
Next
Range('l2', Cells(d.Count 1, 'l')) = Application.Transpose(Application.Transpose(d.items))
Set d = Nothing
End Sub
我们还可以换个思路去想，我们可以循环出一个姓名的时候就把该姓名对应的日期和时间写入字典，然后把keys和items放到相应的位置，姓名也放到相应的位置，然后释放字典，进入下一个循环。
代码2：
Sub 格式转化1()
Dim d As Object, arr1, arr2, i%, j%, rng As Range
arr1 = Range('a2', [h2].End(xlDown))
arr2 = [b1:h1]
For i = 1 To UBound(arr1)
Set d = CreateObject('scripting.dictionary')
For j = 1 To UBound(arr1, 2) - 1 '或者直接写6
d(arr2(1, j)) = arr1(i, j 1) '把星期和时间写入字典
Next
Set rng = Cells([k:k].Rows.Count, 'k').End(xlUp)(2, 1)
rng.Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
rng(1, 0).Resize(d.Count, 1) = arr1(i, 1)
Set d = Nothing
Next
End Sub
思路2中要清晰的知道什么时候创建字典，什么时候释放字典进行下一次循环。同时前面章节中把keys和items输出时都是写的两句代码，本例中用数组的方式可以一次输出。
感谢群友维度和顺其自然给出的建议，聪明的人还那么爱学习，所以我们要更加努力，关注本公众号，坚持每天都进步！
如果看到VBA代码就跟看到天书一样的同学，这里给你们提供另外一种解决办法，简单的操作也可以达到目的。
第一步：
把斜线菜单修改下，直接改成姓名即可。然后选中数据区域，点击数据选项卡，获取和转换，从表格，就会弹出一查询编辑器的界面。
第二步：
在查询编辑器中点击转换，逆透视列，透视其他列，想要的结果就出来了。然后点击开始，关闭并上载，OK，Excel中就会多生成一份表，就是你想要的结果。
今天的分享就到这里了！
想更深入的学习视频教程，请进入公众号后台菜单中了解详情！
联系客服
