求助各位老师，不会字典写法，怎么表1的单价匹配表2 的单价

jorrui111

求助各位老师。求助各位老师，不会字典写法，怎么表1的单价匹配表2 的单价（普通循环运行效率太低，能否有空备注下逻辑？字典用法？）

鄂龙蒙

1. Sub 查询单价()
   
2.     Dim d, ar, arr, i
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Range("E2:E10000").ClearContents
   
5.     ar = Range("A1").CurrentRegion
   
6.     arr = Sheet2.Range("A1").CurrentRegion
   
7.     For i = 2 To UBound(arr)
   
8.         d(arr(i, 3)) = arr(i, 10)
   
9.     Next
   
10.     For i = 2 To UBound(ar)
    
11.         If d.exists(ar(i, 4)) Then ar(i, 5) = d(ar(i, 4))
    
12.     Next
    
13.     [A1].Resize(UBound(ar), 5) = ar
    
14.    Set d = Nothing
    
15. End Sub

复制代码

abc123281

字典基本的用法  建议学习字典基础

jorrui111

鄂龙蒙 发表于 2018-6-26 15:41

老师，好像执行了没有反映

鄂龙蒙

jorrui111 发表于 2018-6-26 16:00
老师，好像执行了没有反映

您要加上表2有的项目呀！！！

一把小刀闯天下

'不用字典来一个，是否正确未做测试，能运行，效率应该还可以

Option Explicit

Sub test()
  Dim i, j, arr, brr, first, t
  arr = Sheets("sheet2").[a1].CurrentRegion: brr = Sheets("sheet1").[a1].CurrentRegion
  t = arr: Call msort(arr, t, 2, UBound(arr, 1), 1, UBound(arr, 2), 3)
  t = brr: Call msort(brr, t, 2, UBound(brr, 1), 1, UBound(brr, 2), 4)
  first = 2
  For i = 2 To UBound(brr, 1)
    For j = first To UBound(arr, 1)
      If brr(i, 4) = arr(j, 3) Then
        brr(i, 5) = arr(j, 10)
        first = j + 1: Exit For
      End If
  Next j, i
  Call msort(brr, t, 2, UBound(brr, 1), 1, UBound(brr, 2), 1)
  Sheets("sheet1").[g1].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End Sub

Function msort(arr, temp, first, last, left, right, key)
  Dim i, j, k, kk, mid
  If first <> last Then
    mid = Int((first + last) / 2)
    msort arr, temp, first, mid, left, right, key
    msort arr, temp, mid + 1, last, left, right, key
    i = first: j = mid + 1: k = first
    While i <= mid And j <= last
      If arr(i, key) <= arr(j, key) Then
        For kk = left To right: temp(k, kk) = arr(i, kk): Next
        k = k + 1: i = i + 1
      Else
        For kk = left To right: temp(k, kk) = arr(j, kk): Next
        k = k + 1: j = j + 1
      End If
    Wend
    While i <= mid
      For kk = left To right: temp(k, kk) = arr(i, kk): Next
      k = k + 1: i = i + 1
    Wend
    While j <= last
      For kk = left To right: temp(k, kk) = arr(j, kk): Next
      k = k + 1: j = j + 1
    Wend
    For i = first To last
      For j = left To right
        arr(i, j) = temp(i, j)
    Next j, i
  End If
End Function