[已解决]谢谢lyn666666老师，数据导入，根据某一列标识和另一列的标识，分列导入结

lhj323323

h740xOgS.rar (30.07 KB, 下载次数: 3)

2010-1-28 21:05 上传

点击文件名下载附件
[求助]数据导入，根据某一列标识和另一列的标识，分列导入结果表的不同列。

老师：

需求如题，在上传的附件中有更明细的说明，请帮忙看看如何实现这个需求，谢谢了

[此贴子已经被作者于2010-1-28 22:46:35编辑过]

最佳答案

月排行榜 / 总排行榜

lyn666666

2010-1-28 21:54

FVxPcJWy.rar (29.31 KB, 下载次数: 17)

2010-1-28 21:54 上传

点击文件名下载附件
[求助]数据导入，根据某一列标识和另一列的标识，分列导入结果表的不同列。

跳转到最佳答案楼层

lyn666666

FVxPcJWy.rar (29.31 KB, 下载次数: 17)

2010-1-28 21:54 上传

点击文件名下载附件
[求助]数据导入，根据某一列标识和另一列的标识，分列导入结果表的不同列。

青城山苦丁茶

试试：

Sub test()
Dim i1 As Integer, arr1(), arr2()
Set dr = CreateObject("scripting.Dictionary")
Set dc = CreateObject("scripting.Dictionary")
With Sheets("C")
  i1 = .Range("a65536").End(xlUp).Row
  .Range("b2:f" & i1).Clear
  arr1 = .Range("A1:f" & i1).Value
  For i1 = 2 To 6
     dc(arr1(1, i1) & "") = i1
  Next
  For i1 = 2 To UBound(arr1)
     dr(arr1(i1, 1) & "") = i1
  Next
  arr2 = Sheets("92表").Range("f2", Sheets("92表").Range("i65536").End(xlUp)).Value
  For i1 = 1 To UBound(arr2)
    If dr.exists(arr2(i1, 3)) And dc.exists(arr2(i1, 2)) Then arr1(dr(arr2(i1, 3)), dc(arr2(i1, 2))) = arr2(i1, 4)
  Next
  .Range("A1:f" & dr.Count + 1) = arr1
End With
End Sub

lhj323323

青城老师，测试不成功，什么也没有导出来