vba按行和列条件查找对应值返回

hnzz416cxm

要求说明：
1、成果表（第6行）  和  原数据表（第6行）的表头内容一样，但顺序不一样；
2、成果表（第B列）  和  原数据表（第B列）的内容一样，但顺序不一样；
3、需根据 成果表 的B列和第6行表头，查找原数据表 的B列和第6行表头对应值并返回填入成果表中；

4、特殊建议：建议加入可选择性C-F列，G-J列，K-W列分区查找填入功能（即：点击宏按键，可以选择C-F列，G-J列，K-W列分区查找并填写，可以单分区，也可以全部。

5、感谢！

fzxba

hnzz416cxm

fzxba 发表于 2022-12-20 12:55

非常好，学习了，但还有些不懂

3190496160

Sub 匹配()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long, y As Long, ys As Long, j As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("原数据")
    rs = .Cells(Rows.Count, 2).End(xlUp).Row
    ys = .Cells(6, Columns.Count).End(xlToLeft).Column
    ar = .Range(.Cells(6, 2), .Cells(rs, ys))
End With
With Sheets("成果表")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    y = .Cells(6, Columns.Count).End(xlToLeft).Column
    If r < 7 Then MsgBox "成果表为空！": End
    .Range(.Cells(7, 3), .Cells(r, y)) = Empty
    br = .Range(.Cells(6, 2), .Cells(r, y))
    For i = 2 To UBound(br)
        If Trim(br(i, 1)) <> "" Then
            d(VBA.Trim(br(i, 1))) = i
        End If
    Next i
    For j = 2 To UBound(br, 2)
        If Trim(br(1, j)) <> "" Then
            d(VBA.Trim(br(1, j))) = j
        End If
    Next j
    For i = 2 To UBound(ar)
        If VBA.Trim(ar(i, 1)) <> "" Then
            xh = d(VBA.Trim(ar(i, 1)))
            If xh <> "" Then
                For j = 2 To UBound(ar, 2)
                    lh = d(VBA.Trim(ar(1, j)))
                    If lh <> "" Then
                        br(xh, lh) = ar(i, j)
                    End If
                Next j
            End If
        End If
    Next i
    .Range(.Cells(6, 2), .Cells(r, y)) = br
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

vba按行和列条件查找对应值返回.rar (20.83 KB, 下载次数: 36)

2022-12-20 14:35 上传

点击文件名下载附件

3190496160

hnzz416cxm 发表于 2022-12-20 14:05
运行时错误

朋友，反馈不是你这样反馈的，

hnzz416cxm

3190496160 发表于 2022-12-20 14:37
朋友，反馈不是你这样反馈的，

对不起，是我没表达清楚。这次非常好用，牛，向你学习。

hnzz416cxm

3190496160 发表于 2022-12-20 14:36

再请教：如果成果表中C-J列有手工填写的数据，只需要查K-W列并返回值，并不把C-J列的已有的数据檫掉，请问怎么改，谢谢大师

3190496160

hnzz416cxm 发表于 2022-12-20 14:51
对不起，是我没表达清楚。这次非常好用，牛，向你学习。

好用就送小花呀
2楼的代码不是我的，我的在4楼，只不过是多管了一次闲事而已，

hnzz416cxm

嗯， 好的。再请教：如果成果表中C-J列有手工填写的数据，只需要查K-W列并返回值，并不把C-J列的已有的数据檫掉，请问怎么改，谢谢大师