根据相内容文本合并或取唯一或数字求和~求代码完善

梦月影

企业名称

认证模式

是否转版

所属区域

现场人日

备注

file:///C:/Users/10566/AppData/Local/Temp/msohtmlclip1/01/clip_image001.png

企业名称

认证模式

企业名称

认证模式

是否转板版

所属区域

公司1

Q监1

是

华南

1.5

A老师，周日

公司1

Q监1     E监1     S监1

公司1

Q监1     E监1     S监1

是

华南

公司1

E监1

是

华南

2

A老师，周日

公司2

Q监3     E监3     S监3

file:///C:/Users/10566/AppData/Local/Temp/msohtmlclip1/01/clip_image003.png

公司2

Q监3     E监3     S监3

是

华北

公司1

S监1

否

华南

2

A老师，周日

公司3

Q监3     E监3     S监3

公司3

Q监3     E监3     S监3

否

湖南

公司2

Q监3

是

华北

3

B老师，周日

公司4

Q监1     E监1     S监1

目前实现按照公司汇总认证模式，希望能够升级到后面这个模式，原来我用VBA加很多公式，结果运行起来特别慢

公司4

Q监1     E监1     S监1

否

华北

公司2

E监3

是

华北

4.5

B老师，周日

公司5

Q监1     S监1     E监1

公司5

Q监1     S监1     E监1

是

湖南

公司2

S监3

否

华北

4.5

B老师，周日

公司6

Q监3     E监3     S监3     Q再认证     E再认证     S再认证

公司6

Q监3     E监3     S监3     Q再认证     E再认证     S再认证

是

华南

具体请大神们看下附件，是数据处理的帖子，已经实现了某个功能，本来是VBA和函数想结合，结果运行速度奇慢，求大神帮忙完善以下~

梦月影

帖子顶上去~求大神们帮忙~

jiangxiaoyun

1. Sub cd()
   
2.     Dim arr, brr()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheet1.[a1].CurrentRegion
   
5.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6.     For i = 2 To UBound(arr)
   
7.         If Not d.exists(arr(i, 1)) Then
   
8.             k = k + 1
   
9.             d(arr(i, 1)) = k
   
10.             For j = 1 To UBound(arr, 2)
    
11.                 brr(k, j) = arr(i, j)
    
12.             Next
    
13.         Else
    
14.             r = d(arr(i, 1))
    
15.             brr(r, 2) = brr(r, 2) & Chr(10) & arr(i, 2)
    
16.             brr(r, 5) = brr(r, 5) + arr(i, 5)
    
17.             If arr(i, 3) = "是" Then brr(r, 3) = "是"
    
18.         End If
    
19.     Next
    
20.     Sheet2.[a2:f666666] = ""
    
21.     Sheet2.[a2].Resize(k, UBound(brr, 2)) = brr
    
22. End Sub
    

复制代码

jiangxiaoyun

工作簿4.zip (24.89 KB, 下载次数: 3)

2018-7-8 09:07 上传

点击文件名下载附件

梦月影

jiangxiaoyun 发表于 2018-7-8 09:07

谢谢大神！！！