实现查询功能宏程序：查询有相同下级部门的上级部门

327765116

实现功能：查询有相同下级部门的上级部门（输入清单）
查找逻辑：AA和CC都包含下层部门CCC,如果是查询界面输出AA,结果输出CC（输出清单）


请帮忙编写宏程序，谢谢

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, dic, s
  Set dic = CreateObject("scripting.dictionary")
  arr = [a1].CurrentRegion
  s = [i2].Value
  For i = 2 To UBound(arr, 1)
    If arr(i, 1) = s Then
      For j = 2 To UBound(arr, 1)
        If arr(j, 2) = arr(i, 2) And i <> j Then dic(arr(j, 1)) = j
      Next
    End If
  Next
  If dic.Count > 0 Then
    [j2] = Join(dic.keys, ",")
  Else
    [j2] = vbNullString
  End If
End Sub