Sub DüşeyaraRenklendir()
For Each hücre In Selection
    If Left(hücre.Formula, 8) = "=VLOOKUP" Then
        değer = Split(Split(hücre.Formula, "(")(1), ",")(0)
        aralık = Split(Split(hücre.Formula, "(")(1), ",")(1)
        sütun = Split(Split(hücre.Formula, "(")(1), ",")(2)
    
        On Error GoTo hata:
        hücre.Interior.Color = Range(aralık).Find(Range(değer)).Offset(0, sütun - 1).Interior.Color
    End If
sonraki:
Next
Exit Sub
hata:
değer = Replace(değer, """", "")
hücre.Interior.Color = Range(aralık).Find(değer).Offset(0, sütun - 1).Interior.Color
GoTo sonraki
End Sub