☰

Excel VBA 函数用于值和格式查找

tag-icon • tag-icon microsoft-excel formatting worksheet-function vba
Excel VBA 函数用于值和格式查找

我需要一个自定义函数来查找单元格值并复制源格式。我有两列值列表。第一列是整数，第二列是相应的文本值。例如：

AB
--- ----------
1 我的第一个值
2 我的第二个价值观
3 我的第三个价值观

我想查找我提供的值，因为它与 A 列中的值相对应。根据在 A 列中找到的具有匹配值的单元格的行号，它将选择 B 列中的相应值。使用 Excel 中的 LOOKUP() 函数很容易做到这一点。但是，我还想复制 B 列中单元格的文本格式。

最初我使用 VBA 函数来解决这个问题，但不幸的是，函数无法更改单元格的格式。希望有人能提供一些解决方法。

答案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

答案2

一般来说，在单元格中输入的函数无法改变其所在单元格的格式，因为函数不知道它位于哪个单元格中。解决这个问题的唯一方法是将当前单元格的地址传递给函数。

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

该函数将在单元格 B1 中输入为=LookupWithFormatting(A1, IDSource, TextSource, B1)。

如果您没有太多格式，您可以考虑使用条件格式，而不是编写 VBA 函数。（您需要为查找表中的每个值设置单独的条件格式。）

相关内容