楼主
kevinchengcw |
利用VBA及字典功能，可以良好的实现数据区交换功能，本例所引用为一交换实例，代码如下：- Sub test()
- Dim Dic1, Dic2, Arr
- Dim M, N, I As Integer
- Set Dic1 = CreateObject("scripting.dictionary") '创建字典
- Set Dic2 = CreateObject("scripting.dictionary")
- With Worksheets("表1")
- I = .Cells.Find("期末金额").Column '查找“期末金额”所在的列
- For M = .Cells.Find("期末金额").Row + 2 To .Cells(.Cells.Find("合计：").Row - 1, I).End(3).Row '枚举“期末金额”到“合计”之间有数据的单元格
- If .Cells(M, I).Value < 0 Then '如果单元格是负值
- Dic1.Add .Cells(M, I - 3).Value & "|" & .Cells(M, I - 2).Value & "|" & .Cells(M, I - 1).Value, Abs(.Cells(M, I).Value) '添加字典项，对应的负值取绝对值
- .Range(.Cells(M, I - 3), .Cells(M, I)).ClearContents '清空已添加项目数据
- End If
- Next M
- End With
- With Worksheets("表2")
- I = .Cells.Find("期末金额").Column '取得“期末金额”所在列
- For M = .Cells.Find("期末金额").Row + 2 To .Cells(.Cells.Find("合计：").Row - 1, I).End(3).Row '枚举“期末金额”与“合计”之间有数据的单元格
- If .Cells(M, I).Value < 0 Then '如果单元格是负值
- Dic2.Add .Cells(M, I - 3).Value & "|" & .Cells(M, I - 2).Value & "|" & .Cells(M, I - 1).Value, Abs(.Cells(M, I).Value) '添加字典项
- .Range(.Cells(M, I - 3), .Cells(M, I)).ClearContents '清空已添加数据
- End If
- Next M
- Arr = Dic1.keys '将字典1的keys赋值给数组
- M = .Cells(.Cells.Find("合计").Row - 1, I - 3).End(3).Row + 1 '取得对应数据区的第一个空行
- For N = LBound(Arr) To UBound(Arr) '循环写入另一工作表里取得的对应项
- Debug.Print Split(Arr(N), "|")(0)
- .Cells(M, I - 3) = Split(Arr(N), "|")(0)
- .Cells(M, I - 2) = Split(Arr(N), "|")(1)
- .Cells(M, I - 1) = Split(Arr(N), "|")(2)
- .Cells(M, I) = Dic1(Arr(N))
- M = M + 1
- Next N
- End With
- Erase Arr '清空数组
- With Worksheets("表1") '继续对“表1”进行同样操作
- I = .Cells.Find("期末金额").Column
- Arr = Dic2.keys
- M = .Cells(.Cells.Find("合计").Row - 1, I - 3).End(3).Row + 1
- For N = LBound(Arr) To UBound(Arr)
- .Cells(M, I - 3) = Split(Arr(N), "|")(0)
- .Cells(M, I - 2) = Split(Arr(N), "|")(1)
- .Cells(M, I - 1) = Split(Arr(N), "|")(2)
- .Cells(M, I) = Dic2(Arr(N))
- M = M + 1
- Next N
- End With
- Set Dic1 = Nothing '清空项目
- Set Dic2 = Nothing
- End Sub
本例中使用了查找引用，对于添加删除行列，只要不影响到表格区的结构就不会影响代码结果
详见附件
 数据互换.rar
|