输入编号查找并输入该编号相应的内容

bommmmm

如图  谢谢帮助！

一把小刀闯天下

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$J$7" Then Exit Sub
  Dim arr, pos, i, j, t, m
  t = Trim(Target.Value)
  If Len(t) = 0 Then Exit Sub
  arr = Sheets("sheet2").[a1].CurrentRegion
  pos = Array(0, 0, 3, 2, 4, 5, 6, 8) '对应关系,自己修改，，，
  ReDim brr(1 To 8, 1 To 7)
  For i = 3 To UBound(arr, 1)
    If arr(i, 9) = t Then
      m = m + 1
      If m > UBound(brr, 1) Then MsgBox "超过:" & UBound(brr, 1): Exit Sub
      brr(m, 1) = m
      For j = 2 To UBound(brr, 2): brr(m, j) = arr(i, pos(j)): Next
    End If
  Next
  [a6].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End Sub

bommmmm

一把小刀闯天下 发表于 2019-3-15 06:29
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

谢谢  谢谢谢谢谢谢！！！！！！