求助老师帮忙看看如何提取数据

风洞小木鱼

菜鸟求助老师，按条件来提取数据。见附件表上说明

太极拍天雄

练习一下！！！！

杨建营

请楼主参考。

ykcbf1100

参与一下。

太极拍天雄

ykcbf1100 发表于 2023-3-2 12:56
参与一下。

如果项目名称和金额不同的情况下，这个代码只能提取第1次出现的数据了。

ykcbf1100

太极拍天雄 发表于 2023-3-2 13:38
如果项目名称和金额不同的情况下，这个代码只能提取第1次出现的数据了。

是的。源数据就是这样的。同一个编号，数据肯定相同。
如果不同，那代码稍改一下就行。

风洞小木鱼

ykcbf1100 发表于 2023-3-2 13:59
是的。源数据就是这样的。同一个编号，数据肯定相同。
如果不同，那代码稍改一下就行。

老师，代码怎么修改 能给点建议吗

ykcbf1100

风洞小木鱼 发表于 2024-2-27 16:37
老师，代码怎么修改 能给点建议吗

一年前的帖子你也翻出来啊

gwjkkkkk

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, br, i&, r&
   
    If Target.Address <> "$B$3" Then Exit Sub
   
    ar = Sheets(2).[A1].CurrentRegion.Value
    ReDim br(1 To UBound(ar), 1 To 6)
    For i = 2 To UBound(ar)
        If ar(i, 1) = Target.Value Then
             r = r + 1
             br(r, 1) = ar(i, 3)
             br(r, 6) = ar(i, 4)
        End If
    Next i
    If r Then
        Application.EnableEvents = False
        [A6].CurrentRegion.Offset(1).ClearContents
        [A7].Resize(r, 6) = br
        Application.EnableEvents = True
    Else
        MsgBox "未找到符合的数据！"
    End If
End Sub

gwjkkkkk

请参考。。。