Função Excel VBA para pesquisa de valor e formato

Question

Eu preciso de uma função personalizada para pesquisar um valor de célula e copiar o formato de origem. Eu tenho uma lista de valores em duas colunas. O primeiro é de inteiros e a segunda coluna é os valores de texto correspondentes. Por exemplo:

A B
--- ----------
1 Meu primeiro valor
2 Meu segundo valor
3 Meu terceiro valor

Eu quero pesquisar o valor que forneço, pois corresponde àqueles da coluna A. Com base no número da linha da célula encontrada com o valor correspondente na coluna A, ele selecionará o valor correspondente na coluna B. Isso é fácil suficiente com a função LOOKUP () no Excel. No entanto, eu também quero copiar a formatação de texto da célula na coluna B.

Inicialmente eu me aproximei disso usando uma função VBA, mas infelizmente uma função não pode alterar a formatação de uma célula. Gostaria de receber ideias sobre como abordar.

    

Answer 1

Sub test()
    On Error GoTo Suberror
    'turn off screen updating
    Application.ScreenUpdating = False
    'ask for input
    strName = InputBox(Prompt:="Lookup Value", _
              Title:="Lookup Value", Default:="0")
        'if no input - exit
        If strName = "0" Or _
               strName = vbNullString Then

               Exit Sub
        'otherwise Find
        Else

            Columns("A:A").Select
            Selection.Find(What:=strName, After:=ActiveCell, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False).Activate

            'Copy
            ActiveCell.Offset(0, 1).Copy

        End If

        'Paste to the range that you define
            Range("J1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
                xlNone, SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _
                xlNone, SkipBlanks:=False, Transpose:=False
Suberror:
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    End Sub

    

Answer 2

Em geral, as funções inseridas em uma célula não podem alterar a formatação da célula em que estão porque a função não sabe em qual célula ela está. A única maneira de contornar isso é passar o endereço da célula atual para a função .

Function LookupWithFormatting(rValue As Range, rLookup As Range, rResult As Range, rFormatThisCell As Range) As String

A função seria inserida na célula B1 como =LookupWithFormatting(A1, IDSource, TextSource, B1) .

Se você não tiver muitos formatos, considere a possibilidade de usar a formatação condicional em vez de gravar uma função do VBA. (Você precisaria de um formato condicional separado para cada valor em sua tabela de pesquisa.)