请老师们帮忙修改一下代码

laoshenji

各位老师，本求助附件中的《汇总》的代码是 蓝桥玄霜 版主亲自写的，很好用。但在实际操作中，本人想在各分表的A1（合并后）单元格自动引用各自的标签名，岂料当把所有分表（注：《查询》、《汇总》除外）的A1:E1合并后，《汇总》的第4数据行均显示为错误内容（注：显示的内容为各分表的列标题）。令人恼火的是：此后，即使撤销所有分表的A1合并单元格，《汇总》第4数据行的错误仍得不到纠正。因为本人是VBA盲，对VBA一点也不懂，故请老师们帮忙修改一下代码。同时请赐教：为什么所有分表的A1单元格不能是合并单元格？假若在所有分表的第2数据行右侧添加“单位：元”内容后，又会对汇总结果产生什么影响？谢谢！
补：我瞎猜，是不是要修改多表去重复的代码？

laoshenji

敬请老师们相助！

microyip

没见有错啊，蓝老写东西，怎么会有错？

蓝桥玄霜

汇总表的第四行A~G的数据与我的代码无关，只有分表中数据的位置有关系，
你现在是表头在第3行，所以可以把：
For i = 2 To UBound(Brr)
改为
For i = 4 To UBound(Brr)

laoshenji

蓝桥玄霜 发表于 2017-5-24 11:29
汇总表的第四行A~G的数据与我的代码无关，只有分表中数据的位置有关系，
你现在是表头在第3行，所以可以把 ...

谢版主。按照您的指点，我将《模块3》的  For i = 2 To UBound(Brr)
改为：For i = 4 To UBound(Brr) 后，《汇总》第4数据行没有显示不正确内容了（显示为空），问题是：《汇总》的B4仍显示“部门名称”，C4仍显示“个人名称”。烦请版主再费心看看，再谢！

laoshenji

microyip 发表于 2017-5-24 10:35
没见有错啊，蓝老写东西，怎么会有错？

谢谢microyip老师。蓝版已帮忙找出了其中一个问题，请老师再费心看看其他问题，再谢！

laoshenji

microyip 发表于 2017-5-24 10:35
没见有错啊，蓝老写东西，怎么会有错？

谢谢microyip老师。蓝版已帮忙找出了其中一个问题，请老师再费心看看其他问题，再谢！

laoshenji

microyip 发表于 2017-5-24 10:35
没见有错啊，蓝老写东西，怎么会有错？

谢谢microyip老师。蓝版已帮忙找出了其中一个问题，请老师再费心看看其他问题，再谢！

laoshenji

蓝桥玄霜 发表于 2017-5-24 11:29
汇总表的第四行A~G的数据与我的代码无关，只有分表中数据的位置有关系，
你现在是表头在第3行，所以可以把 ...

问题还未全面解决，烦请版主及老师们继续相助。谢谢大家！

king2751500

蓝桥玄霜 发表于 2017-5-24 11:29
汇总表的第四行A~G的数据与我的代码无关，只有分表中数据的位置有关系，
你现在是表头在第3行，所以可以把 ...

尊敬的蓝版，您好，麻烦看下http://club.excelhome.net/thread-1348013-1-1.html
我是新人，刚学VBA,自己写了一段，但是运行结果不对，不知道哪里错误，请帮忙修改下
Sub 宏1()
Dim Arr, i&, Brr(1 To 5000, 1 To 5000), j&, n&, aa
Sheet2.Activate
Arr = Sheet2.[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(Arr)
    If InStr(Arr(i, 2), "/") Then
        aa = Split(Arr(i, 2), "/")
        For j = 0 To UBound(aa)
            Brr(i, j + 1) = aa(j)
            If Not d.exists(Brr(i, j + 1)) Then
            Set d(Brr(i, j + 1)) = Range("c" & i)
        Else
            Set d(Brr(i, j + 1)) = Union(d(Brr(i, j + 1)), Range("c" & i))
        End If
        Next
    Else
        
        Brr(i, 1) = Arr(i, 2)
        If Not d.exists(Brr(i, 1)) Then
            Set d(Brr(i, 1)) = Range("c" & i)
        Else
            Set d(Brr(i, 1)) = Union(d(Brr(i, 1)), Range("c" & i))
        End If
    End If
   
Next
[d1].Resize(i, j + 1) = Brr
Sheet1.Activate
r = Range("a65536").End(xlUp).Row
For k = 1 To r
ss = Range("a" & k).Value
If d.exists(ss) Then
            Cells(i, 2) = d(ss)
        End If
Next
End Sub