VBA 将字符串的一部分格式化为下标的函数
VBA Function to format parts of a string as subscripts
我有一些文本用于跟踪长方程中的一堆变量。这是一个简短的示例：
要求
我正在尝试制作一个 VBA 函数，它将三个单元格作为输入，return 您在 Term 列（列D).
它将采用 Coef 单元格并将其格式化，以便第一个字符后的所有内容都被下标，然后对 Variable 单元格。
如果 Coef Value 的值 > 0，那么函数应该 return 串联 subscripted_Coef & "*" & subscripted_Variable（其中 subscripted_Coef 和 subscripted_Variable 是伪代码);否则它应该 return 0.
问题
我的问题是当我在单元格（例如单元格 E3）中调用函数时，我在 Visual Basic 中收到错误消息：
单击“确定”在 Visual Basic 中以黄色突出显示 Public Function ConstructTerm(coef_cell, var_cell, coef_value)。
我是 VBA 的新手，所以在这一点上我迷路了。在另一个 Whosebug post 的帮助下，我能够制作一个宏以将正确的格式应用于选定的单元格（虽然没有复制共享 link），但我在转换时遇到了问题那变成一个功能。为了这个 post 的长度，我不会 post 那个宏代码，但如果需要我可以。
单元格 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
更新
这是我最终得到的代码，可以执行我想要的操作。感谢
编辑： 完全忘记了原始代码的 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:
'
' 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
您可以使用事件代码来实现您的目标。
例如，将此模块安装在您的table所在工作表的工作表代码模块中。
前三列的单元格发生变化时触发代码
然后，根据第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
我有一些文本用于跟踪长方程中的一堆变量。这是一个简短的示例：
要求
我正在尝试制作一个 VBA 函数，它将三个单元格作为输入，return 您在 Term 列（列D).
它将采用 Coef 单元格并将其格式化，以便第一个字符后的所有内容都被下标，然后对 Variable 单元格。
如果 Coef Value 的值 > 0，那么函数应该 return 串联 subscripted_Coef & "*" & subscripted_Variable（其中 subscripted_Coef 和 subscripted_Variable 是伪代码);否则它应该 return 0.
问题
我的问题是当我在单元格（例如单元格 E3）中调用函数时，我在 Visual Basic 中收到错误消息：
单击“确定”在 Visual Basic 中以黄色突出显示 Public Function ConstructTerm(coef_cell, var_cell, coef_value)。
我是 VBA 的新手，所以在这一点上我迷路了。在另一个 Whosebug post 的帮助下，我能够制作一个宏以将正确的格式应用于选定的单元格（虽然没有复制共享 link），但我在转换时遇到了问题那变成一个功能。为了这个 post 的长度，我不会 post 那个宏代码，但如果需要我可以。
单元格 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
更新
这是我最终得到的代码，可以执行我想要的操作。感谢
编辑： 完全忘记了原始代码的 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:
'
' 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
您可以使用事件代码来实现您的目标。
例如，将此模块安装在您的table所在工作表的工作表代码模块中。
前三列的单元格发生变化时触发代码
然后，根据第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