Fonction Excel VBA pour la recherche de valeur et de format

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

En général, les fonctions saisies dans une cellule ne peuvent pas modifier le formatage de la cellule dans laquelle elles se trouvent, car la fonction ne sait pas dans quelle cellule elle se trouve. La seule façon de contourner ce problème est de transmettre l'adresse de la cellule actuelle à la fonction.

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

La fonction serait entrée dans la cellule B1 comme suit =LookupWithFormatting(A1, IDSource, TextSource, B1) .

Si vous n'avez pas beaucoup de formats, vous pouvez envisager d'utiliser la mise en forme conditionnelle au lieu d'écrire une fonction VBA. (Vous auriez besoin d'un format conditionnel distinct pour chaque valeur de votre table de consultation).