粗体化细胞的特定部分

时间：2016-09-30 14:30:19

标签： excel vba excel-vba

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

示例：

经销商： Josh

我试过了

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

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

4 个答案:

答案 0 :(得分：15)

您可以使用以下函数在公式中加粗一些输入文本

因此，在您的单元格中，您现在可以输入= Bold（＆＃34;经销商：＆＃34;）＆amp; 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

答案 1 :(得分：1)

正如他们已经告诉过的那样，如果后者来自同一单元格中的公式/函数，则无法格式化部分单元格值

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

不幸的是，我实际上无法抓住你真正的环境，所以这里有一些盲目的镜头：

第一个“环境”

你有一个VBA代码在某个时刻运行，如下所示：

currentDate = currentDate.getNextMonth()
currentDate = currentDate.getPreviousMonth()

并且您希望Cells(5, 1).Formula = "=""Dealer: "" & CustomerName" 部分加粗

  • 最简单的方法就是

    "Dealer:"

  • 但您也可以使用With Cells(5, 1) .Formula = "=""Dealer: "" & CustomerName" .Value = .Value .Characters(1, 7).Font.Bold = True End With 事件处理程序，如下所示：

    您的VBA代码仅为

    Worksheet_Change()

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

    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 id

    • 时将其作为一种良好做法

第二个“环境”

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

Application.EnableEvents = False

其中="Dealer:" & CustomerName 是命名范围

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

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

所以我要检查更改的单元格是否为Worksheet_Change()一个（即对应于valid命名区域）然后使用扫描预定义范围的子进行查找并格式化所有具有使用该命名范围的公式的单元格，如下所示（注释可以帮助您）：

well known

答案 2 :(得分：1)

<强>要求：

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

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

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

enter image description here

图1

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

enter image description here

图2

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

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

enter image description here

图3

建议为此范围创建Defined Name。以下代码会创建名为Defined Name的{​​{1}}。

RptDealer

按照上述准备工作，现在我们可以创建将链接到名为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 的输出范围的Shape。在工作表RptDealer中的单元格A5处选择并按照Dynamically display cell range contents in a picture的说明操作，或者如果您愿意，请使用以下代码添加并格式化链接的Report。

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

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

enter image description here 图4

答案 3 :(得分：0)

而不是引用你可以简单地获取单元格并将其放在变量中，并基本上附加它。从这里，您可以使用.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.
相关问题
最新问题