Excel VBA - Usando dicionário Excel

[isabela queiroz]

Boa Dia! Precisava fazer um dicionário, com as seguintes condições:

-Ir no Sheet1 e procurar a coluna "Customer" e pegar de 1 em 1 e pesquisar no Sheet2 por Dicionário

- Sendo a chave o nome "inBiz" (coluna A do sheet2) e o valor: "AG" (coluna B)

- Quando encontrasse o valor necessário, retornar o valor para o sheet1 coluna "Retornar aqui" (sendo as respostas correspondente a coluna "Customer")

-Se não encontrar o valor procurado, retornar "Not found" e pintar de azul, por exemplo. 

 

Ex. Clube.xlsx

[Midori]

@isabela queiroz Na prática seria um procv para retornar na coluna B o resultado da busca pelo Customer? Não entendi o que quer dizer com dicionário.

[Scofieldgyn]

@isabela queiroz veja o anexo se é o que espera.

 

Como a @Midoridisse, só um procv resolve.

Ex. Clube.xlsx

[isabela queiroz]

@Scofieldgyn parece funcionar perfeitamente, mas tem como passar para codigo VBA procurando pelo "nome" e não pela celula/coluna?

 

ex. eu acho que para fazer o iferror ficaria assim mais ou menos

Dim varIfError As Variant
varIfError = WorksheetFunction.IfError(0, "Not Found")

 

[Scofieldgyn]

@isabela queirozSegue:

 

Sub PesquisarValores()
 
Dim UL As Long, Cust As Long, rtaqui As Long
Dim Col As Variant

    Cust = Rows(2).Find("Customer").Column
    rtaqui = Rows(2).Find("Retornar aqui").Column
    UL = Cells(Cells.Rows.Count, Cust).End(xlUp).Row
    
    For inicio = 3 To UL
        Col = Cells(inicio, Cust).Value
        resultado_procv = Application.VLookup(Col, Sheets("Sheet2").Range("A:B"), 2, False)
        If IsError(resultado_procv) Then
            Cells(inicio, rtaqui).Value = "Not found"
        Else
            Cells(inicio, rtaqui).Value = resultado_procv
        End If
    Next inicio
 
End Sub

 

[isabela queiroz]

@Scofieldgyn parece estar funcionando, mas como faço para alem de colocar que não foi encontrado pintar a celula ou a propria linha do item que não achou?

[Scofieldgyn]

@isabela queirozvocê pode fazer manualmente por formatação condicional.

 

mas caso não queira manualmente, segue o código modificado.

Sub PesquisarValores()
 
Dim UL As Long, Cust As Long, rtaqui As Long
Dim Col As Variant

    Cust = Rows(2).Find("Customer").Column
    rtaqui = Rows(2).Find("Retornar aqui").Column
    UL = Cells(Cells.Rows.Count, Cust).End(xlUp).Row
    
    For inicio = 3 To UL
        Cells(inicio, rtaqui).FormatConditions.Delete
        Col = Cells(inicio, Cust).Value
        resultado_procv = Application.VLookup(Col, Sheets("Sheet2").Range("A:B"), 2, False)
        If IsError(resultado_procv) Then
            Cells(inicio, rtaqui).Value = "Not found"
        Else
            Cells(inicio, rtaqui).Value = resultado_procv
        End If
    Next inicio

    For Each palavra In Selection
        If palavra.Value = "Not found" Then
        palavra.Interior.Color = vbBlue
        palavra.Font.Color = vbWhite
        Else
        End If
    Next palavra

End Sub

 

[isabela queiroz]

@Scofieldgynpor conta do For each estar "fora" do for inicio o codigo não ta passando por ele.. e quando testo só ele separado ele ignora o Next palavra e vai direto pro fim da sub

[Scofieldgyn]

@isabela queiroz

 

segue:

 

Sub PesquisarValores()
 
Dim UL As Long, Cust As Long, rtaqui As Long
Dim Col As Variant


    Cust = Rows(2).Find("Customer").Column
    rtaqui = Rows(2).Find("Retornar aqui").Column
    UL = Cells(Cells.Rows.Count, Cust).End(xlUp).Row
    
    Range("B3:B" & Cust).ClearContents

    For inicio = 3 To UL
        Col = Cells(inicio, Cust).Value
        resultado_procv = Application.VLookup(Col, Sheets("Sheet2").Range("A:B"), 2, False)
        If IsError(resultado_procv) Then
            Cells(inicio, rtaqui).Value = "Not found"
        Else
            Cells(inicio, rtaqui).Value = resultado_procv
        End If
    Next inicio

    Call ColorirCélula
    
End Sub

Sub ColorirCélula()

Dim xRg As Range
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant

    xVrt = "Not Found"
    If xVrt <> "" Then
    Set xFRg = ActiveSheet.Cells.Find(what:=xVrt)
        If xFRg Is Nothing Then
        MsgBox prompt:="Valor não encontrado" & vbOK
        Exit Sub
        End If
    xStrAddress = xFRg.Address
    Set xRg = xFRg
        Do
        Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
        Set xRg = Application.Union(xRg, xFRg)
        Loop Until xFRg.Address = xStrAddress
        If xRg.Count > 0 Then
        xRg.Interior.ColorIndex = 23
        End If
    End If
End Sub