如何进行一对多可重复循环查找，并自动生成非参数列，求大神帮助，谢谢~

Stonebud

求助
如何根据sheet1中B列“条目组”在sheet2中查找到对应的所有“条目名”，将查找到的“条目名”与相应的“条目组”都复制到sheet1 E-F列，并在sheet1的D列显示相应的公司编号。最终效果见图三。表格原件见附件。

我查找了论坛里面以前的帖子改了下，但只能做到将“条目名”与相应的“条目组”复制到sheet1 E-F列来，但是没办法同时生成公司编号。


Sub expandattributes()

      Dim rng1 As Range, arr, i%, m%, rng2 As Range
    m = 0
    arr = Worksheets("Sheet2").Range("A1").CurrentRegion
    For Each Rng In Worksheets("Sheet1").Range("B2:B" & Range("B1048576").End(3).Row)
       For i = 2 To UBound(arr)
          If Rng.Value = arr(i, 1) Then
            m = m + 1
            With Worksheets("Sheet2")
             Set rng1 = .Range(.Cells(i, 1), .Cells(i, 3))
            If rng2 Is Nothing Then
              Set rng2 = rng1
            Else
              Set rng2 = Union(rng1, rng2)
            End If
             End With
           End If
       Next
       If m = 0 Then MsgBox Rng.Value & "not exists."
       m = 0
   Next
   If Not rng2 Is Nothing Then
      rng2.Copy Worksheets("Sheet1").Range("E2")
   End If
   Worksheets("Sheet1").Columns("E:F").AutoFit
End Sub


求大神指点！拜谢！

Stonebud

不好意思，才发现图片是倒着来的，我想要的最终效果应该是图一这样的，表一是第三张图片，表二是第二张图片