Функция Excel VBA для поиска значения и формата

Question

Мне нужна пользовательская функция для поиска значения ячейки и копирования исходного формата. У меня есть список значений в двух столбцах. Первый из целых чисел, а второй столбец соответствующие текстовые значения. Например:

AB
--- ----------
1 Моя первая ценность
2 Мое второе значение
3 Мое третье значение

Я хочу посмотреть значение, которое я предоставляю, так как оно соответствует значениям в столбце А. На основании номера строки ячейки, найденной с соответствующим значением в столбце A, он выберет соответствующее значение в столбце B. Это достаточно просто с помощью функции LOOKUP() в Excel. Тем не менее, я также хочу скопировать текстовое форматирование ячейки в столбце B.

Первоначально я подошел к этому с помощью функции VBA, но, к сожалению, функция не может изменить форматирование ячейки. Был бы признателен за идеи о том, как подойти.

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

Как правило, функции, введенные в ячейку, не могут изменить формат ячейки, в которой они находятся, потому что функция не знает, в какой ячейке она находится. Единственный способ обойти это - передать адрес текущей ячейки в функцию.

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

Функция будет введена в ячейку B1 как =LookupWithFormatting(A1, IDSource, TextSource, B1) .

Если у вас мало форматов, вы можете рассмотреть возможность использования условного форматирования вместо написания функции VBA. (Вам потребуется отдельный условный формат для каждого значения в таблице поиска.)