Excel VBA下划线引用的单元格数据 [英] Excel VBA to underline referenced cell data

问题描述

我在单元格A10中有一个文本字符串，它以工作表输入"单元格C2中的数据开头.我希望对引用的数据加下划线.例如，如果Input！C2中包含"John Smith"，则看起来应该像"John Smith在使用此公式时遇到麻烦"，并在John Smith加上下划线.以下是我拥有的代码，但无法正常工作-强调了整个文本字符串.另外，当我在这里时，如何才能使其自动运行，而不必手动运行宏?预先感谢.

I have a string of text in cell A10, which begins with data from Sheet "Input," cell C2. I want the referenced data to be underlined. For example, if "John Smith" was in Input!C2, it should look like "John Smith is having trouble with this formula" with John Smith underlined. Below is the code I have, but it's not working -- it's underlining the entire string of text. Also, while I'm here, how can I get this to run automatically, rather than having to manually run the macro? Thanks in advance.

Sub Macro()

With Range("A10")
    .Value = Range("Input!C2") & " is having trouble with this formula"
    .Characters(1, Len(Range("Input!C2"))).Font.Underline = True
End With

End Sub

推荐答案

在普通模块中尝试一下(假设合同"是您的 A10 所在的位置)...

Try this in normal module (assuming the "Contract" is where your A10 is)...

Option Explicit

Sub Macro()
    Dim sTxt As String
    Application.EnableEvents = False ' Added this
    With Worksheets("Contract").Range("A10")
        .Font.Underline = xlUnderlineStyleNone
        sTxt = Range("Input!C2").Text
        If Len(sTxt) = 0 Then
            .ClearContents
        Else
            .Value = sTxt & " is having trouble with this formula"
            .Characters(1, Len(sTxt)).Font.Underline = xlUnderlineStyleSingle
        End If
    End With
    Application.EnableEvents = True ' Added this
End Sub

然后在输入工作表模块中(已更新):

Then in Input worksheet module (updated):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oRng As Range
    Set oRng = Union(Range("B2"), Range("B4"), Range("C2"))
    If Not Intersect(Target, oRng) Is Nothing Then Macro
End Sub

注意
如果 Input！C2 包含公式，则需要 Union 与 Intersect()相关的其他范围，否则它们不会自动更新变化.

NOTE
If the Input!C2 contains formula, you need to Union other ranges involved in the Intersect() or it won't auto update on their changes.

或者，您可以在工作表计算上强制自动更新，将以下内容添加到输入工作表模块中:

Alternatively, you can force auto update on the Worksheet calculation, add below to the Input worksheet module:

Private Sub Worksheet_Calculate()
    Macro ' Will not work if Worksheet calculation is Manual
End Sub

代码去向的屏幕截图:

Screenshots for where the code goes:

这篇关于Excel VBA下划线引用的单元格数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！