请求高手解决一个问题，请见附件。谢谢！

11111.rar (1.72 KB)
下载次数: 9

复制内容到剪贴板

代码:

Sub aa()
    Dim arr, d As Object, i%
    arr = Sheet1.Range("b2", "c10")
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr)
        d(arr(i, 1)) = arr(i, 2)
    Next
    [b22].Resize(d.Count) = Application.Transpose(d.keys)
    [c22].Resize(d.Count) = Application.Transpose(d.items)
End Sub

附件

222.rar(7.53 KB)

2011-8-9 00:27, 下载次数: 1

复制内容到剪贴板

代码:

Sub yy()
    Dim d As Object, r, i%, k%
    Set d = CreateObject("Scripting.Dictionary")
    r = Range("a1:c" & [a65536].End(3).Row)
      For n = 2 To UBound(r) ' Step -1
       If Not d.exists(r(n, 2)) Then
       k = k + 1: r(k, 3) = r(n, 3)
          r(k, 2) = r(n, 2): r(k, 1) = k
          d(r(k, 2)) = k
       Else
          r(d(r(n, 2)), 3) = r(n, 3)
       End If
      Next
      [e1].Resize(k, 3) = r: Set d = Nothing
End Sub

Book2.rar (7.27 KB)
下载次数: 0