条件跨表查找对应的最后值

a18b88

见附件，谢谢！ 跨表条件查找最后值.rar (5.9 KB, 下载次数: 24)

2019-3-23 11:02 上传

点击文件名下载附件

a18b88

自己顶一下，谢谢各位大侠！

719404338

1. Sub t()
   
2. Dim i, d
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For i = 3 To Sheet2.[a65536].End(3).Row
   
5.   d(Sheet2.Range("a" & i).Value) = Sheet2.Range("h" & i)
   
6. Next i
   
7. For i = 3 To [a65536].End(3).Row
   
8. Range("l" & i) = d(Range("a" & i).Value)
   
9. Next i
   
10. End Sub
    

复制代码

a18b88

谢谢您 719404338 老师！代码简练高效，鲜花奉上。

lsc900707

字典的基本运用问题。实际表格中不会有空列吧？

a18b88

谢谢您版主！

jiminyanyan

http://club.excelhome.net/forum. ... ead&tid=1467559
题不一样，内容和这个很像

everbest2015

Sub mydemo()
    Dim r&, ar, s$, i&, d As Object
    r = Sheet2.Cells(Rows.Count, "a").End(xlUp).Row
    If r > 1 Then
        ar = Sheet2.[a1].Resize(r, 4)
        Set d = CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(ar)
            s = ar(i, 1) & "☆" & ar(i, 2) & "☆" & ar(i, 3)
            If ar(i, 4) <> "" Then
                d(s) = ar(i, 4)
            End If
        Next
        r = Sheet1.Cells(Rows.Count, "a").End(xlUp).Row
        If r > 1 Then
            ar = Sheet1.[a1].Resize(r, 4)
              For i = 2 To UBound(ar)
                    s = ar(i, 1) & "☆" & ar(i, 2) & "☆" & ar(i, 3)
                    If d.exists(s) Then
                        ar(i, 4) = d(s)
                    End If
              Next
              Sheet1.[a1].Resize(r, 4) = ar
        End If
        Set d = Nothing
    Else
        Exit Sub
    End If
End Sub

a18b88

谢谢8楼朋友，测试不成功。