时间戳

首页 > 解决方案 > VBA函数将字符串的一部分格式化为下标

excel - VBA函数将字符串的一部分格式化为下标

问题描述

我有一些文本用于跟踪长方程中的一堆变量。这是一个简短的示例：

在此处输入图像描述

要求

我正在尝试制作一个 VBA 函数，它将三个单元格作为输入并返回您在Term列（D 列）中看到的内容。

它将获取Coef单元格并对其进行格式化，以便第一个字符之后的所有内容都有下标，然后对变量单元格执行相同的操作。

如果Coef Value的值> 0，则该函数应返回串联subscripted_Coef & "*" & subscripted_Variable（其中subscripted_Coef和subscripted_Variable是伪代码）；否则它应该返回 0。

问题

我的问题是当我在单元格（例如单元格 E3）中调用该函数时，我在 Visual Basic 中收到一条错误消息：

在此处输入图像描述

单击确定Public Function ConstructTerm(coef_cell, var_cell, coef_value)在 Visual Basic 中以黄色突出显示。

我对 VBA 很陌生，所以在这一点上我迷路了。在另一个 StackOverflow 帖子的帮助下（虽然没有复制共享链接），我能够制作一个宏以将正确的格式应用于选定的单元格，但我无法将其转换为函数。为了这篇文章的篇幅，我不会发布那个宏代码，但如果需要我可以。

单元格 E2 显示了我之前用来获取所需输出的 ​​IF 语句，但它没有应用我想要的下标格式。它显示了我想要的逻辑，但 ISBLANK() 部分除外（我可以不用它）。

到目前为止的代码

Public Function ConstructTerm(coef_cell, var_cell, coef_value)
' =================================================================================================
' For a selection of cells combine the coefficient and variable parts to make the term for that
' contribution to the larger equation. This function will later be called to create the entire 
' equation when a button is pressed in the Excel Worksheet. 
'
' INPUTS:
'   - coef_cell: (String) The cell containing the string for the coefficient part
'   - var_cell: (String) The cell containing the string for the variable part
'   - coef_value: (Double) The value of the coefficient. If value = 0 then return 0 instead of the
'                  concatenated string
'
' OUTPUTS:
'   - (String) The concatenated string in the format <coef_cell>*<var_cell> with the proper subscripts
'      on both the coef_cell and var_cell.
' =================================================================================================
Dim s1 As String
Dim s2 As String

s1 = make_subscript(coef_cell)
s2 = make_subscript(var_cell)
If coef_value = 0 Then
    ConstructTerm = 0
Else
    ConstructTerm = s1 & "*" & s2
End If

End Function


Public Function MakeSubscript(cell_str)
' =================================================================================================
' Make all characters after the 1st character in a string subscripted. This function is a variation
' on the subprocedure named make_subscript()
'
' INPUTS:
'   - cell_str: (String) The string that needs to have all characters after the first character subscripted
'
' OUTPUTS:
'   - (String) The contents of the string with all the characters after the first subscripted
' =================================================================================================
With cell_str.Characters(Start:=1, Length:=1).Font
    .Subscript = False
End With
With cell_str.Characters(Start:=2).Font
    .Subscript = True
End With
make_subscript = cell_str
End Function

更新

这是我最终做我想做的事情的代码。感谢Ron Rosenfeld 的解决方案

编辑： 完全忘记了原始代码的 ISBLANK 部分，没什么大不了的。它会自动更新，因此如果进行更改，则会自动反映更改。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' =================================================================================================
' Use event code to automatically apply the proper formatting to the 'Term' column.
'
' When any of the cells in columns for coefficient, variable, or coefficient value are changed the
' cell to the right of column coefficient value is updated with the string representation of the
' product of coef and variable cells for that row; the numbers will be properly subscripted.
'
' -------------------------------------------------------------------------------------------------
' *************************************************************************************************
' * WARNING: ASSUMES A RIDIG LAYOUT OF THE DATA! DO NOT ATTEMPT TO USE ON ANYTHING OTHER THAN     *
' *          workbook_name.xlsm WORKSHEET [worksheet name].                               *
' *************************************************************************************************
' -------------------------------------------------------------------------------------------------
'
' This code must be placed in the worksheet code module of the worksheet containing the target
' data. For more info on worksheet code see https://www.contextures.com/xlvba01.html
' -------------------------------------------------------------------------------------------------
'
' TODO
' -  Need to have the cell retain whatever border/shading formatting it had before the change to
'    one of the three columns occurs. Low priority though.
' - When changing values in one of the three columns, the values entered don't appear in the cell
'   as they are being entered... but they show up in the formula bar properly. Weird...
' -------------------------------------------------------------------------------------------------
'
' Code source: https://stackoverflow.com/a/64807624/11895567
'
' Minor modifications made for compatability with production worksheet instead of test worksheet
' and other minor code formatting changes to suit my preferences. (, on 11-12-2020)
'
' Created on 11-12-2020
' =================================================================================================
Dim rngToCheck As Range
Dim C As Range
Dim s1 As String
Dim s2 As String
Dim sRes As String
Dim I As Long

Dim coef_col As Integer
Dim coef_val_col As Integer
Dim variable_col As Integer

coef_col = 5                ' Coef column is Column E
variable_col = coef_col + 1 ' Variable column is Column F
coef_val_col = coef_col + 2 ' Coef Value column is Column G

' determine last filled in row of column E, and expand to E:G
Set rngToCheck = Range(Cells(1, coef_col), Cells(Rows.Count, coef_col).End(xlUp)).Resize(columnsize:=3)
If Not Intersect(rngToCheck, Target) Is Nothing Then    ' Is the changed cell within the rngToCheck
    Application.EnableEvents = False                    ' Disable event checking so as not to retrigger
                                                        '     when writing results
    For Each C In Intersect(rngToCheck, Target)         ' subscript the appropriate characters
        With C
            If Cells(C.Row, coef_val_col) <> 0 Then
                s1 = Cells(C.Row, coef_col)
                s2 = Cells(C.Row, variable_col)
                sRes = s1 & "*" & s2
                With Cells(C.Row, coef_val_col + 1)
                    .ClearFormats
                    .Value = sRes
                    For I = 1 To Len(sRes)
                        If IsNumeric(Mid(sRes, I, 1)) Then
                            .Characters(I, 1).Font.Subscript = True
                        End If
                    Next I
                End With
            End If
        End With
    Next C
End If
Application.EnableEvents = True 're-enable event code; if macro exits prematurely, this won't happen
End Sub

标签： excelvbafunctionstring-formatting

解决方案

您可以使用事件代码来实现您的目标。

例如，将此模块安装在您的表格所在工作表的工作表代码模块中。

  • 代码在前三列中的单元格发生变化时触发

  • 然后，根据第 3 列的内容，它将根据下标数字的方案进行下标（您可能想要更改它）

  • 我的代码没有你的注释那么好，但你应该能够得到图片并进行任何适当的更改

  • 另外，还有一些需要补充的

    • 如果您删除第 1 列的内容，它会从 rngToCheck 中删除，因此第一步可能需要清空 rngToCheck 下方的所有内容
    • 可能需要不同的算法来确定下标字符

0如果第 3 列中为空白，则编辑为空白单元格

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngToCheck As Range, C As Range
    Dim s1 As String, s2 As String, sRes As String
    Dim I As Long
    
    
'determine last filled in row of column A, and expand to A:C
Set rngToCheck = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)

'Is the changed cell within the rngToCheck
If Not Intersect(rngToCheck, Target) Is Nothing Then

    'Disable event checking so as not to retrigger when writing results
    Application.EnableEvents = False
    
    'subscript the appropriate characters
    For Each C In Intersect(rngToCheck, Target)
        With C
            If Cells(C.Row, 3) <> 0 Then
                s1 = Cells(C.Row, 1)
                s2 = Cells(C.Row, 2)
                sRes = s1 & "*" & s2
                
                With Cells(C.Row, 4)
                    .ClearFormats
                    .Value = sRes
                    For I = 1 To Len(sRes)
                        If IsNumeric(Mid(sRes, I, 1)) Then
                            .Characters(I, 1).Font.Subscript = True
                        End If
                    Next I
                End With
            Else
                Cells(C.Row, 4) = 0
            End If
        End With
    Next C
End If

're-enable event code
'if macro exits prematurely, this won't happen
Application.EnableEvents = True

End Sub

推荐阅读