楼主
kevinchengcw |
下面的示例是将分组关系表中的分组名对应的人名及产量比例提取后应用到记录表中，将分组中人员及对应产量按关系表中的数据拆分存成对应行。
应用中存在下列知识点：
1. 合并单元格及对应内容的获取
2. 字典储存规则的确立及提取
3. 单元格数据区与数组之间的转换
4. 数据组合拆分技巧
代码如下：
- Sub test()
- Dim Dic, Arr, Arr2
- Dim M, N, I As Long
- Dim Str As String
- Set Dic = CreateObject("scripting.dictionary") '建立字典，用于存储对应的人名及产量比例
- With Worksheets("jcwh") '在基础维护表中统计数据
- .Activate '因为要用到select方法，所以要激活工作表，否则会出错
- .Cells(6, 2).Select '选定开始的单元格
- Do
- Str = "" '清空用于串联人名和产量比例的字符串值
- For M = Selection.Row To Selection.Row + Selection.Rows.Count - 1 '在选定单元格的第一行到最后一行之间循环
- Str = Str & .Cells(M, 3).Value & "|" & .Cells(M, 4).Value & vbTab '串接人名和产量比例
- Next M
- Dic.Add ActiveCell.Value, Left(Str, Len(Str) - 1) '将分组姓名作为key，人名和产量比例的字符串作为item添加到字典中
- ActiveCell.Offset(1, 0).Select '下移一个单元格（注意：这句对于处理合并单元格比较关键）
- If ActiveCell.Row > .Cells(.Rows.Count, 2).End(3).Row Then Exit Do '如果已经超出了有数据的范围就退出循环
- Loop
- End With
- With Worksheets("sj1") '到操作表中来进行处理
- .Activate '同样先激活工作表
- If .Cells(1, 11).Value <> "员工姓名" Then '判断是否已经处理过，如未处理过则添加员工姓名列
- .Columns(11).Insert Shift:=xlToRight
- .Cells(1, 11) = "员工姓名"
- End If
- For M = .Cells(.Rows.Count, 10).End(3).Row To 2 Step -1 '因为有插入行的动作，所以从后向前操作
- If Dic.exists(.Cells(M, 10).Value) Then '如果分组姓名存在于字典中，则
- Arr = Split(Dic(.Cells(M, 10).Value), vbTab) '对字典的对应item项依特定字符分割放入数组
- If UBound(Arr) > 0 Then '如果数组项目上限值大于0（即有两个以上的员工姓名存在）
- .Rows(M + 1 & ":" & M + UBound(Arr)).Insert Shift:=xlDown '则选择下面一行到数组上限值的行插入空白行（仔细研究一下这里的逻辑）
- .Rows(M).Copy .Rows(M + 1 & ":" & M + UBound(Arr)) '将当前行的内容复制到插入的空白行中
- Arr2 = Application.Transpose(Application.Transpose(.Cells(M, 12).Resize(1, .Cells(M, .Columns.Count).End(1).Column - 11))) '将当前行的员工姓名后的数据串接后赋值给数组2
- For N = LBound(Arr) To UBound(Arr) '循环数组里存在的人名
- .Cells(M, 10).Offset(N, 1) = Split(Arr(N), "|")(0) '将人名与产量比例依特定字符分割开放入对应单元格中
- For I = LBound(Arr2) To UBound(Arr2) - 1 '循环数组2的数据项，因最后一个数据是日期，所以只循环到上限-1 这里
- If Arr2(I) <> "" Then .Cells(M, 10).Offset(N, I + 1) = .Cells(M, 10).Offset(N, I + 1).Value * Split(Arr(N), "|")(1) '如果数组内容不为空，则对应值与产量比例相乘赋值给对应单元格
- Next I
- Next N
- End If
- End If
- Next M
- End With
- End Sub
附示例文件。
 产量统计.rar
|
