求一个汇总的VBA程序（万分感谢zhaogang1960前辈）

zhaogang1960 · 发表于 2011-2-12 22:35

求助.rar (27.08 KB, 下载次数: 23)

puresway · 发表于 2011-2-12 22:41

前辈，非常感谢您！能不能再问一下，如果汇总表中的第一行文件1，文件2，文件3。。。。也是固定的位置，怎样改写代码才能实现不同文件的相应业绩对号入座呢？很想学习，谢谢前辈！

zhaogang1960 · 发表于 2011-2-12 22:53

原帖由 puresway 于 2011-2-12 22:41 发表
前辈，非常感谢您！能不能再问一下，如果汇总表中的第一行文件1，文件2，文件3。。。。也是固定的位置，怎样改写代码才能实现不同文件的相应业绩对号入座呢？很想学习，谢谢前辈！

Sub Macro1()
Dim d As Object, dic As Object, ds As Object, arr, sh As Worksheet, MyPath$, MyName$, i&, s$, m%
Set sh = ActiveSheet
Set d = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")
arr = [b1].Resize(, [a1].CurrentRegion.Columns.Count - 1)
For i = 1 To UBound(arr, 2) Step 2
      ds(arr(1, i) & "A型") = i
      ds(arr(1, i) & "B型") = i + 1
Next
arr = Sheets("销售人员信息").[a1].CurrentRegion
For i = 2 To UBound(arr)
      dic(arr(i, 2)) = arr(i, 1)
Next
arr = Range("A4:A" & Range("A65536").End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 256)
For i = 1 To UBound(arr)
      If dic.Exists(arr(i, 1)) Then d(dic(arr(i, 1))) = i
Next
Application.ScreenUpdating = False
[a1].CurrentRegion.Offset(3, 1).ClearContents
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls")
Do While MyName <> ""
      If MyName <> ThisWorkbook.Name Then
         m = m + 2
         s = "文件" & Split(MyName, ".")(0)
         sh.Cells(1, m) = s
         With GetObject(MyPath & MyName)
            arr = .Sheets(1).[a1].CurrentRegion
            .Close False
         End With
         For i = 2 To UBound(arr)
            If d.Exists(arr(i, 4)) And ds.Exists(s & arr(i, 2)) Then brr(d(arr(i, 4)), ds(s & arr(i, 2))) = brr(d(arr(i, 4)), ds(s & arr(i, 2))) + arr(i, 3)
         Next
      End If
      MyName = Dir
Loop
[b4].Resize(UBound(brr), m) = brr
Application.ScreenUpdating = True
MsgBox "ok"
End Sub

zhaogang1960 · 发表于 2011-2-12 22:54

求助.rar (27.98 KB, 下载次数: 10)

puresway · 发表于 2011-2-12 23:04

前辈，好像不行啊，比如我把文件夹下03文件重命名为04，执行后汇总表中第一行出现两个文件04，但对应范围没有业绩写入，您看一下麻烦前辈了

puresway · 发表于 2011-2-12 23:12

应该还是我表达的有问题

，就是希望实现文件夹下如果有03,05文件，就在汇总表中第一行的文件03,05对应的列中写入相应人员业绩，就比如某月3日的业绩写到汇总表3日列下，5日写到汇总表5日列下。真麻烦前辈了！谢谢！

zhaogang1960 · 发表于 2011-2-12 23:16

原帖由 puresway 于 2011-2-12 23:04 发表
前辈，好像不行啊，比如我把文件夹下03文件重命名为04，执行后汇总表中第一行出现两个文件04，但对应范围没有业绩写入，您看一下麻烦前辈了

求助.rar (28.3 KB, 下载次数: 65)

puresway · 发表于 2011-2-12 23:21

前辈这次行了，太感谢您了！

感谢前辈的耐心，小弟敬佩万分！谢谢您！

puresway · 发表于 2011-2-14 20:56

前辈，销售人员信息如果不是一对一，而是多对一，如何实现正确匹配、汇总呢，比如郑州、开封、洛阳、平顶山的销售人员都是周培芳，这样的话造成其业绩汇总不正确，该怎么办呢？感激不尽!

soulmatejiejie · 发表于 2011-2-14 21:04

。。。。你也该自己研究研究吧。。

		自动登录	找回密码
密码			免费注册

[已解决] 求一个汇总的VBA程序（万分感谢zhaogang1960前辈）