楼主
kevinchengcw |
Q: 如何用字典储存复杂的数据区域内容并根据指定区域的变化予以提取转置？
A: 现以本例示范如何用字典完成这一处理的流程，代码如下：
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Dic
- Dim Str As String
- If Target.Row > 3 And Target.Column = 1 Then '如果target范围在指定范围内，则执行
- Application.ScreenUpdating = False '操作涉及了工作表切换等，关闭屏幕刷新提高速度，同时防止闪屏
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目
- With Worksheets("填空版") '在填空版中为字典添加内容
- .Activate '因涉及单元格的select方法，所以先激活工作表
- .[a4].Select '选中起始单元格（合并单元格）
- Do While .Cells(Selection.Row, Selection.Column) <> "" '当合并单元格的内容不为空时执行循环（注意：因是合并单元格，注意单元格地址的表达方式）
- Str = CStr(.Cells(Selection.Row, Selection.Column).Value) '因对应内容是日期值，为防止出错，将其转化为文本后赋值给字符串变量Str
- '下面添加字典项目，注意比较复杂
- '因要添加的区域有两行，并且中间有一列不需要添加，所以每一行分成两段来写，单元格的值用vbtab相间隔，而两行之间用分隔符“|”来分隔
- Dic.Add Str, _
- Join(Application.Transpose(Application.Transpose(.Cells(Selection.Row + Selection.Rows.Count - 2, 3).Resize(1, 5))), vbTab) _
- & vbTab & _
- Join(Application.Transpose(Application.Transpose(.Cells(Selection.Row + Selection.Rows.Count - 2, 9).Resize(1, 2))), vbTab) _
- & "|" & _
- Join(Application.Transpose(Application.Transpose(.Cells(Selection.Row + Selection.Rows.Count - 1, 3).Resize(1, 5))), vbTab) _
- & vbTab & _
- Join(Application.Transpose(Application.Transpose(.Cells(Selection.Row + Selection.Rows.Count - 1, 9).Resize(1, 2))), vbTab)
- Selection.Offset(1, 0).Select '选择当前选定单元格下方的单元格
- Loop
- End With
- With Worksheets("报表") '到报表单元格来写入数据
- .Activate '先激活
- Str = CStr(.Cells(Target.Row, Target.Column).Value) '取得target对应单元格的值，并转化为文本赋值给字符串变量Str
- If Dic.exists(Str) Then '如果存在该字典项，则将item项依分隔符“|”进行分割，前段依vbtab分割后放入对应单元格范围，后一段同样处理后放入另一单元格范围
- Cells(Target.Row, 2).Resize(1, 7) = Application.Transpose(Application.Transpose(Split(Split(Dic(Str), "|")(0), vbTab)))
- Cells(Target.Row + 1, 2).Resize(1, 7) = Application.Transpose(Application.Transpose(Split(Split(Dic(Str), "|")(1), vbTab)))
- End If
- End With
- Set Dic = Nothing '清空字典项目
- Application.ScreenUpdating = True '打开屏幕刷新
- End If
- End Sub
字典就像一个大仓库，只要处理好数据结构，可以储存很多复杂的数据内容。
附示例文件。
 生产力-.rar
|