我想做个，自动能提取信息的表格，哪位大神帮忙一下。

zjminy

Sheet2的E6至BY6 是需要填写的内容
如果SHEET2的C列中，是有数值的合并单元格，则在SHEET1的A列中搜索 （A列也是合并单元格) ，如果SHEET2 C列的数值等于SHEET1 A列的数值
则读取SHEET1中 A列所对应的数值
如表二C列中  数值是24A082 ，则在表一的A列中找到24A082
并根据 表二中E2的 产品设计员 信息查到表一A列中的24A082 对应的产品设计人员 的开始日期，并填入表二的 E4 信息栏 ,然后对应的E5填入计划结束的日期。
因为数值比较多 E2,F2,D2-----BY2对应的是不同的项目。
哪位大神能帮忙一下吗？
谢谢

蓝桥玄霜

提取的例子：
附件做得比较马虎，至少需提供2~3个图号。

3190496160

Sub 数据匹配()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim rn As Range
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set sh = Sheets("sheet1")
With sh
    w = .UsedRange.Rows.Count
    x = .UsedRange.Columns.Count
    br = .Range(.Cells(1, 1), .Cells(w, x))
End With
With Sheets("sheet2")
    r = .Cells(Rows.Count, 4).End(xlUp).Row
    y = .Cells(2, Columns.Count).End(xlToLeft).Column
    If r < 5 Then MsgBox "导入蔬菜定价 工作表为空，请先导入数据！": End
    ar = .Range(.Cells(1, 1), .Cells(r, y))
    For j = 5 To y
        If ar(2, j) <> "" Then
            d(ar(2, j)) = j
        End If
    Next j
    For i = 3 To UBound(ar)
        If ar(i, 3) <> "" Then
            zd = ar(i, 3)
            Set rn = sh.Columns(1).Find(zd, , , , , , 1)
            If rn Is Nothing Then MsgBox "数据源中找不到" & zd: End
            ks = rn.Row
            hs = sh.Cells(ks, 1).MergeArea.Rows.Count
            js = ks + hs - 1
            ar(i, 5) = br(ks, 4)
            For s = ks To js
                If br(s, 3) <> "" Then
                    lh = d(br(s, 3))
                    If lh <> "" Then
                        ar(i + 1, lh) = br(s, 5)
                        ar(i + 2, lh) = br(s, 6)
                        ar(i + 3, lh) = br(s, 7)
                    End If
                End If
            Next s
        End If
    Next i
    .Range(.Cells(1, 1), .Cells(r, y)) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

工作簿1.rar (19.87 KB, 下载次数: 16)

2024-4-27 11:39 上传

点击文件名下载附件

3190496160

表格乱糟糟的，而且，表格与描述不完全相符，代码仅供参考

zjminy

3190496160 发表于 2024-4-27 11:40
表格乱糟糟的，而且，表格与描述不完全相符，代码仅供参考

大神，你的代码很给力。

zjminy

3190496160 发表于 2024-4-27 11:40
表格乱糟糟的，而且，表格与描述不完全相符，代码仅供参考

你能再帮忙修改一下么，我没说清楚 。我想表二的E3至BY能读取表一D12以下的内容。

3190496160

zjminy 发表于 2024-4-29 12:04
你能再帮忙修改一下么，我没说清楚 。我想表二的E3至BY能读取表一D12以下的内容。

说实话，目前的代码都是猜谜语，猜着写的，你现在说的，更是不知道是什么意思

zjminy

3190496160 发表于 2024-4-29 12:14
说实话，目前的代码都是猜谜语，猜着写的，你现在说的，更是不知道是什么意思

已经解决了，没事了哈哈