加粗单元格的特定部分

Question

我有一个引用为="Dealer: " & CustomerName 的单元格。 CustomerName 是字典引用的名称。我怎么能只加粗“经销商：”而不是客户名称。

例子：

经销商：乔希

我试过了

Cells(5, 1).Characters(1, 7).Font.Bold = True

但它似乎只适用于未引用的单元格。我怎样才能让它在引用的单元格上工作？

Answer 1

您可以使用以下函数将公式中的某些输入文本加粗

因此，您现在可以在您的单元格中输入 =Bold("Dealer: ")&CustomerName

确切地说，这只会增加字母字符（a 到 z 和 A 到 Z），所有其他字符都将保持不变。我没有在不同的平台上测试过它，但似乎可以在我的平台上工作。可能并非所有字体都支持。

 Function Bold(sIn As String)
    Dim sOut As String, Char As String
    Dim Code As Long, i As Long
    Dim Bytes(0 To 3) As Byte

    Bytes(0) = 53
    Bytes(1) = 216

    For i = 1 To Len(sIn)
        Char = Mid(sIn, i, 1)
        Code = Asc(Char)
        If (Code > 64 And Code < 91) Or (Code > 96 And Code < 123) Then
            Code = Code + IIf(Code > 96, 56717, 56723)
            Bytes(2) = Code Mod 256
            Bytes(3) = Code \ 256
            Char = Bytes
        End If
        sOut = sOut & Char
    Next i
    Bold = sOut
End Function

编辑：

已经努力重构上面的内容以展示它是如何工作的，而不是让它充满神奇的数字。

  Function Bold(ByRef sIn As String) As String
     ' Maps an input string to the Mathematical Bold Sans Serif characters of Unicode
     ' Only works for Alphanumeric charactes, will return all other characters unchanged

     Const ASCII_UPPER_A As Byte = &H41
     Const ASCII_UPPER_Z As Byte = &H5A
     Const ASCII_LOWER_A As Byte = &H61
     Const ASCII_LOWER_Z As Byte = &H7A
     Const ASCII_DIGIT_0 As Byte = &H30
     Const ASCII_DIGIT_9 As Byte = &H39
     Const UNICODE_SANS_BOLD_UPPER_A As Long = &H1D5D4
     Const UNICODE_SANS_BOLD_LOWER_A As Long = &H1D5EE
     Const UNICODE_SANS_BOLD_DIGIT_0 As Long = &H1D7EC

     Dim sOut As String
     Dim Char As String
     Dim Code As Long
     Dim i As Long

     For i = 1 To Len(sIn)
        Char = Mid(sIn, i, 1)
        Code = AscW(Char)
        Select Case Code
           Case ASCII_UPPER_A To ASCII_UPPER_Z
              ' Upper Case Letter
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_UPPER_A + Code - ASCII_UPPER_A)
           Case ASCII_LOWER_A To ASCII_LOWER_Z
              ' Lower Case Letter
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_LOWER_A + Code - ASCII_LOWER_A)
           Case ASCII_DIGIT_0 To ASCII_DIGIT_9
              ' Digit
              sOut = sOut & ChrWW(UNICODE_SANS_BOLD_DIGIT_0 + Code - ASCII_DIGIT_0)
           Case Else:
              ' Not available as bold, return input character
              sOut = sOut & Char
        End Select
     Next i
     Bold = sOut
  End Function

  Function ChrWW(ByRef Unicode As Long) As String
     ' Converts from a Unicode to a character,
     ' Includes the Supplementary Tables which are not normally reachable using the VBA ChrW function

     Const LOWEST_UNICODE As Long = &H0              '<--- Lowest value available in unicode
     Const HIGHEST_UNICODE As Long = &H10FFFF        '<--- Highest vale available in unicode
     Const SUPPLEMENTARY_UNICODE As Long = &H10000   '<--- Beginning of Supplementary Tables in Unicode. Also used in conversion to UTF16 Code Units
     Const TEN_BITS As Long = &H400                  '<--- Ten Binary Digits - equivalent to 2^10. Used in converstion to UTF16 Code Units
     Const HIGH_SURROGATE_CONST As Long = &HD800     '<--- Constant used in conversion from unicode to UTF16 Code Units
     Const LOW_SURROGATE_CONST As Long = &HDC00      '<--- Constant used in conversion from unicode to UTF16 Code Units

     Dim highSurrogate As Long, lowSurrogate As Long

     Select Case Unicode
        Case Is < LOWEST_UNICODE, Is > HIGHEST_UNICODE
           ' Input Code is not in unicode range, return null string
           ChrWW = vbNullString
        Case Is < SUPPLEMENTARY_UNICODE
           ' Input Code is within range of native VBA function ChrW, so use that instead
           ChrWW = ChrW(Unicode)
        Case Else
           ' Code is on Supplementary Planes, convert to two UTF-16 code units and convert to text using ChrW
           highSurrogate = HIGH_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) \ TEN_BITS)
           lowSurrogate = LOW_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) Mod TEN_BITS)
           ChrWW = ChrW(highSurrogate) & ChrW(lowSurrogate)
     End Select

  End Function

有关使用的 unicode 字符的参考，请参见此处http://www.fileformat.info/info/unicode/block/mathematical_alphanumeric_symbols/list.htm

关于 UTF16 的维基百科页面显示了从 Unicode 转换为两个 UTF16 代码点的算法

https://en.wikipedia.org/wiki/UTF-16

Answer 2

正如他们已经告诉过的，如果部分单元格值源自同一单元格中的公式/函数，则不能格式化部分单元格值

但是可能有一些解决方法可能适合您的需求

不幸的是，我无法真正掌握您的真实环境，所以这里有一些盲拍：

---

第一个“环境”

您正在运行一个 VBA 代码，该代码有时会写入如下单元格：

Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"

你想让"Dealer:"部分加粗

• 最直接的方法是

  With Cells(5, 1)
      .Formula = "=""Dealer: "" & CustomerName"
      .Value = .Value
      .Characters(1, 7).Font.Bold = True
  End With
  

• 但您也可以使用Worksheet_Change() 事件处理程序，如下所示：

  您的 VBA 代码只有

  Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"
  

  同时将以下代码放在相关的工作表代码窗格中：

  Private Sub Worksheet_Change(ByVal Target As Range)
      With Target
          If Left(.Text, 7) = "Dealer:" Then
              Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
              On Error GoTo ExitSub
              .Value = .Value
              .Characters(1, 7).Font.Bold = True
          End If
      End With
  
  ExitSub:
      Application.EnableEvents = True '<-- get standard event handling back
  End Sub
  

  On Error GoTo ExitSub 和 ExitSub: Application.EnableEvents = True 不应该是必需的，但是当使用 Application.EnableEvents = False id 时，我将它们作为一个好习惯

---

第二个“环境”

您的 Excel 工作表中有包含公式的单元格，例如：

="Dealer:" & CustomerName

CustomerName 是一个命名范围

您的 VBA 代码将修改该命名范围的内容

在这种情况下，Worksheet_Change() 子将由 命名范围 值更改而不是由包含公式的单元格触发

所以我会检查更改后的单元格是否为valid 一个（即对应于well known 命名范围），然后使用一个扫描预定义范围的子单元，并使用以下公式查找和格式化所有单元格使用该命名范围，如下所示（cmets 应该可以帮助您）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If Not Intersect(ActiveWorkbook.Names("CustomerName").RefersToRange, Target) Is Nothing Then
            Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
            On Error GoTo ExitSub
            FormatCells Columns(1), "CustomerName" '<-- call a specific sub that will properly format all cells of passed range that contains reference to passed "named range" name
        End If
    End With

ExitSub:
    Application.EnableEvents = True '<-- get standard event handling back
End Sub

Sub FormatCells(rng As Range, strngInFormula As String)
    Dim f As Range
    Dim firstAddress As String

    With rng.SpecialCells(xlCellTypeFormulas) '<--| reference passed range cells containg formulas only
        Set f = .Find(what:=strngInFormula, LookIn:=xlFormulas, lookat:=xlPart) '<--| search for the first cell in the referenced range containing the passed formula part
        If Not f Is Nothing Then '<--| if found
            firstAddress = f.Address '<--| store first found cell address
            Do '<--| start looping through all possible matching criteria cells
                f.Value = f.Value '<--| change current cell content into text resulting from its formula
                f.Characters(1, 7).Font.Bold = True '<--| make its first 7 characters bold
                Set f = .FindNext(f) '<--| search for next matching cell
            Loop While f.Address <> firstAddress '<--| exit loop before 'Find()' method wraps back to the first cell found
        End If
    End With
End Sub

Answer 3

要求：

我的理解是，OP 需要在单元格 A5 中包含公式 ="Dealer: " & CustomerName 的结果，以粗体字符显示 Dealer: 部分。 现在，尚不清楚的是公式中CustomerName 部分的性质。此解决方案假定它对应于具有工作簿范围的Defined Name（如果不同，请告诉我）。

我假设使用公式而不是直接编写公式的结果并使用 VBA 程序格式化A5 单元格的原因是允许用户仅通过计算更改来查看来自不同客户的数据工作簿，而不是通过运行 VBA 过程。

假设我们在名为Report 的工作表中有以下数据，定义名称CustomerName 具有工作簿范围并且被隐藏。 位于A5 是公式="Dealer: " & CustomerName Fig.1 显示了带有Customer 1 数据的报告。

图1

现在如果我们将单元格E3中的客户编号更改为4，报告将显示所选客户的数据；无需运行任何 VBA 程序。不幸的是，由于单元格A5 包含一个公式，它的内容字体不能部分格式化为以粗体字符显示“经销商：”。 Fig.2 显示了带有Customer 4 数据的报告。

图2

这里提出的解决方案是Dynamically display the contents of a cell or range in a graphic object

要实现此解决方案，我们需要重新创建所需的输出范围并在 A5 中添加一个 Shape，其中将包含指向输出范围的链接。 假设我们不希望在报告所在的同一工作表中看到此输出范围，并记住 输出范围单元格不能隐藏；让我们在另一个名为“客户数据”的工作表中创建此输出范围，地址为B2:C3（见图 3）。输入B2 Dealer: 和C2 输入公式=Customer Name 然后根据需要格式化每个单元格（B2 字体粗体，C3 可以有不同的字体类型，如果你喜欢 - 让我们应用斜体字体这个样本）。确保范围具有适当的宽度，以免文本溢出单元格。

图3

建议为此范围创建Defined Name。下面的代码创建了名为RptDealer 的Defined Name。

Const kRptDealer As String = "RptDealer" ‘Have this constant at the top of the Module. It is use by two procedures

Sub Name_ReportDealerName_Add()
'Change Sheetname "Customers Data" and Range "B2:C2" as required
    With ThisWorkbook.Sheets("Customers Data")
        .Cells(2, 2).Value = "Dealer: "
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).Formula = "=CustomerName"  'Change as required
        .Cells(2, 3).Font.Italic = True
        With .Parent
            .Names.Add Name:=kRptDealer, RefersTo:=.Sheets("Customers Data").Range("B2:C2") ', _
                Visible:=False 'Visible is True by Default, use False want to have the Name hidden to users
            .Names(kRptDealer).Comment = "Name use for Dealer\Customer picture in report"
        End With
        .Range(kRptDealer).Columns.AutoFit
    End With
    End Sub

按照上述准备工作，现在我们可以创建将链接到名为RptDealer 的输出范围的形状。在工作表Report 中的单元格A5 处选择并按照Dynamically display cell range contents in a picture 的说明进行操作，或者如果您更喜欢使用下面的代码来添加和格式化链接的Shape。

Sub Shape_DealerPicture_Set(rCll As Range)
Const kShpName As String = "_ShpDealer"
Dim rSrc As Range
Dim shpTrg As Shape

    Rem Delete Dealer Shape if present and set Dealer Source Range
    On Error Resume Next
    rCll.Worksheet.Shapes(kShpName).Delete
    On Error GoTo 0

    Rem Set Dealer Source Range
    Set rSrc = ThisWorkbook.Names(kRptDealer).RefersToRange

    Rem Target Cell Settings & Add Picture Shape
    With rCll
        .ClearContents
        If .RowHeight < rSrc.RowHeight Then .RowHeight = rSrc.RowHeight
        If .ColumnWidth < rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth Then _
            .ColumnWidth = rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth
        rSrc.CopyPicture
        .PasteSpecial
        Selection.Formula = rSrc.Address(External:=1)
        Selection.PrintObject = msoTrue
        Application.CutCopyMode = False
        Application.Goto .Cells(1)
        Set shpTrg = .Worksheet.Shapes(.Worksheet.Shapes.Count)
    End With

    Rem Shape Settings
    With shpTrg
        On Error Resume Next
        .Name = "_ShpDealer"
        On Error GoTo 0
        .Locked = msoFalse
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .LockAspectRatio = msoTrue
        .Placement = xlMoveAndSize
        .Locked = msoTrue
    End With

    End Sub

上面的代码可以用这个过程调用：

Sub DealerPicture_Apply()
Dim rCll As Range
    Set rCll = ThisWorkbook.Sheets("Report").Cells(5, 1)
    Call Shape_DealerPicture_Set(rCll)
    End Sub

最终结果是一个行为类似于公式的图片，因为它链接到包含所需公式和格式的输出范围（见图 4）

图4

Answer 4

您可以简单地获取单元格并将其放入变量中，然后基本上附加它，而不是引用。从这里您可以使用 .font.bold 功能来加粗特定部分。假设在第 2 页，您在单元格 a1 中有“经销商：”，在 b1 中有“Josh”。这是一个如何完成的示例：

Worksheets("Sheet1").Cells(5, "a") = Worksheets("Sheet2").Cells(1, "a") & Worksheets("Sheet1").Cells(1, "b")
Worksheets("Sheet1").Cells(5, "a").Characters(1, 7).Font.Bold = True 'Bolds "dealer:" only.