跨表模糊查询提取产品基本信息

天边2021 · 发表于 2023-5-19 21:26

本帖最后由天边2021 于 2023-5-19 21:27 编辑

以查询批号为关键字，在系统数据工作表中查询(模糊查询或精确查询)该批号产品的相关产品信息产品信息包括“物料编码、名称、规格批号、批号、生产日期”五个字段，查询结果显示在本表表头字段下方(带颜色和边框)，并在H列自动编号若系统数据工作表有多条相同的产品基本信息，查询结果显示唯一值即可
当清空查询编号按回车键时，查询结果自动清空，下方单元格自动上移
输入查询批号后按回车键即可呈现结果，可否容易实现，请大神帮忙看看

wang-way · 发表于 2023-5-19 21:33

这个基本上录制宏就可以实现了吧

天边2021 · 发表于 2023-5-19 21:35

wang-way 发表于 2023-5-19 21:33
这个基本上录制宏就可以实现了吧

不这么简单吧？可能是我表述的不太清楚

天边2021 · 发表于 2023-5-19 21:39

天边2021 发表于 2023-5-19 21:35
不这么简单吧？可能是我表述的不太清楚

这个结果是动态的录制的宏里面有变量吗？

wang-way · 发表于 2023-5-19 21:41

Sub ddd()
Set sht1 = Sheets("入库 (2)")
Key = sht1.[c1].Value
If Key = "" Then Exit Sub
Set sht2 = Sheets("系统数据")
With sht2
endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
For i = 2 To endrow
If .Cells(i, "G").Value Like "*" & Key & "*" Then
sht1.Rows(5).Insert
sht1.Cells(5, 3).Value = sht2.Cells(i, 2).Value
End If
Next i
End With
End Sub

复制代码

追风少年丶斌 · 发表于 2023-5-19 22:08

关键词 like

3190496160 · 发表于 2023-5-19 22:33

Sub chaxun()
Dim ar As Variant
Dim br()
Dim rn As Range
With Sheets("系统数据")
   r = .Cells(Rows.Count, 1).End(xlUp).Row
   ar = .Range("a1:j" & r)
End With
With Sheets("入库")
zd = .[c1]
rs = .Cells(Rows.Count, 2).End(xlUp).Row
If zd <> "" Then
      ReDim br(1 To UBound(ar), 1 To 6)
      For i = 2 To UBound(ar)
         If InStr(ar(i, 7), zd) > 0 Then
            n = n + 1
            For j = 2 To 4
                  br(n, j - 1) = ar(i, j)
            Next j
            br(n, 4) = ar(i, 7)
            br(n, 5) = ar(i, 8)
            br(n, 6) = n
         End If
      Next i
      If n = "" Then MsgBox "没有符合条件的数据！": End
      For i = 5 To rs
         If Trim(.Cells(i, 2)) = "" Then
            If rn Is Nothing Then
                  Set rn = .Rows(i)
            Else
                  Set rn = Union(rn, .Rows(i))
            End If
         End If
      Next i
      If Not rn Is Nothing Then rn.Delete
      .Rows("5:" & n + 4).Insert Shift:=xlDown
      .Cells(5, 3).Resize(n, UBound(br, 2)) = br
      .Cells(5, 3).Resize(n, UBound(br, 2)).Borders.LineStyle = 1
      .Cells(5, 3).Resize(n, UBound(br, 2)).Interior.ColorIndex = 10
Else
      For i = 5 To rs
         If Trim(.Cells(i, 2)) = "" Then
            If rn Is Nothing Then
                  Set rn = .Rows(i)
            Else
                  Set rn = Union(rn, .Rows(i))
            End If
         End If
      Next i
      If Not rn Is Nothing Then rn.Delete
End If
End With
End Sub

3190496160 · 发表于 2023-5-19 22:33

Private Sub Worksheet_Change(ByVal T As Range)
If T.Row = 1 And T.Column = 3 Then
Call chaxun
End If
End Sub

3190496160 · 发表于 2023-5-19 22:34

模糊查询提取产品信息.rar (61.99 KB, 下载次数: 22)

天边2021 · 发表于 2023-5-19 22:58

3190496160 发表于 2023-5-19 22:34

非常感谢！

		自动登录	找回密码
密码			免费注册

[求助] 跨表模糊查询提取产品基本信息

评分