请教老师：用ADO+SQL完成多列数据匹配，谢谢！

chxw68

请楼主试试字典的速度。

qx-liuwx

chxw68 发表于 2017-8-8 17:16
请楼主试试字典的速度。

老师的字典代码果然快。谢谢！

qx-liuwx

chxw68 发表于 2017-8-8 17:16
请楼主试试字典的速度。

再继续麻烦老师：我实例的："正、负"这些表约有90个，有何简便方法将这些表名写入数组，谢谢！

chxw68

qx-liuwx 发表于 2017-8-8 20:37
再继续麻烦老师：我实例的："正、负"这些表约有90个，有何简便方法将这些表名写入数组，谢谢！

只能用循环。

qx-liuwx

明白，谢谢老师，我自己修改下

qx-liuwx

Sub test1()
  Application.ScreenUpdating = False: Application.DisplayAlerts = False: Set d = CreateObject("scripting.dictionary")
    r = Cells(Rows.Count, 9).End(xlUp).Row: arr = Range("i20:j" & r)
    For i = 1 To UBound(arr)
      xm = CStr(arr(i, 2))
      If Not d.exists(xm) Then
        Set d(xm) = CreateObject("scripting.dictionary")
      End If
      d(xm)(arr(i, 1)) = i
    Next
  For ii = 1 To 2
    Set ws = Sheets(ii + 1): ReDim brr(1 To UBound(arr), 1 To 1): With ws
      r = .Cells(.Rows.Count, 1).End(xlUp).Row: crr = .Range("a1:e" & r)
      For i = 2 To UBound(crr)
        xm = CStr(crr(i, 1))
        If d.exists(xm) Then
          For j = 2 To UBound(crr, 2)
            If d(xm).exists(crr(1, j)) Then
              m = d(xm)(crr(1, j)): brr(m, 1) = crr(i, j)
            End If
          Next
        End If
      Next
    End With
   Cells(20, 14 + ii).Resize(UBound(brr), 1) = brr
  Next
End Sub


补充内容 (2017-12-14 14:20):
第一段要调整2处

qx-liuwx

     If Not d.exists(xm) Then
        Set d(xm) = CreateObject("scripting.dictionary")
      End If

妙！