楼主
liuguansky |
Q:对工作簿中的非"汇总"工作表的任意两个表相比较，如果其中2个表的股东名称相同，且满足a列为个人股东（也就是股东名称不超过三个字）、e列为“新进”时，将其在各表中的整行添加到“汇总”表中（在汇总表里有个示范），方便对照查看。因为每个季度都增加一张新工作表。
A:用如下代码可以实现：
- Sub JusTTesT()
- Dim D, Arr(), n As Byte, Ar, sn As Byte, i&, j As Byte, K&, ArrR() As String '定义变量
- Set D = CreateObject("scripting.dictionary") '创建字典项目
- ReDim Arr(1 To Sheets.Count - 1) '定义工作表数据区域数组，用于储存各表数据
- For sn = 1 To Sheets.Count '循环工作表
- If Sheets(sn).Name <> "汇总" Then '对非汇总表进行处理
- n = n + 1 '返回满足工作表的数组序号
- Arr(n) = Sheets(sn).Range("a1").CurrentRegion.Value '对数据区域进行赋值予数组
- For i = 1 To UBound(Arr(n), 1) '循环数组，进行处理
- If Trim(Arr(n)(i, 4)) = "个人" And Trim(Arr(n)(i, 5)) = "新进" Then
- '如果股东性质为个人，为新进，则：
- '加TRIM为防止空格的影响
- If D.exists(Arr(n)(i, 1)) Then '如果存在字典项目
- Ar = D(Arr(n)(i, 1)): Ar(2) = Ar(2) + 1: D(Arr(n)(i, 1)) = Ar
- '则对字典的ITEM值进行重新赋值，把ITEM数组中的第三个元素进行累加处理
- 'ITEM数组的第一个元素用来标记数组的位置
- 'ITEM数组的第二个元素用来标记数组中对应值的位置
- 'ITEM数组的第三个元素用来标记数组中满足条件的股东信息条数
- K = K + 1: ReDim Preserve ArrR(1 To 7, 1 To K)
- '对重复的记录进行动态数组的返回
- For j = 1 To 7
- ArrR(j, K) = Arr(n)(i, j)
- Next j
- If D(Arr(n)(i, 1))(2) = 1 Then
- '如果是第二次重复则要返回第一次的值。
- K = K + 1: ReDim Preserve ArrR(1 To 7, 1 To K)
- For j = 1 To 7
- ArrR(j, K) = Arr(D(Arr(n)(i, 1))(0))(D(Arr(n)(i, 1))(1), j)
- '分离出字典项目的标识位，并进行相应值的返回
- Next j
- End If
- Else
- D.Add Arr(n)(i, 1), Array(n, i, 0)
- '如果为新股东，则增加字典项目
- End If
- End If
- Next i
- End If
- Next sn
- With Sheets("汇总")
- .UsedRange.Clear '清空已用区域
- With .Range("a1").Resize(K, 7) '返回结果
- .Value = Application.Transpose(ArrR)
- .Sort Range("A1") '排序，股东信息聚合在一起返回
- End With
- .Range("a1").Select '返回到结果表
- End With
- Set D = Nothing '释放对象
- End Sub
|
