粗体化细胞的特定部分

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 = Falseid 使用时的一个好习惯

第二个“环境”

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

="Dealer:" & CustomerName

其中CustomerName是命名范围

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

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

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

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