Question

尝试为工作制作首字母缩略词列表。第一列列出了首字母缩略词。第二栏列出了首字母缩略词，同时保持主要组成部分的大写。

实施例。 | POC |联络点|

目标是格式化大写字符，以便更容易查看，方法是将它们加粗，增加大小，并将颜色更改为红色。

实施例。 | POC | P oint O f C ontact | ------------ 想象字母是红色的还是更大的

由于我有1000多个首字母缩略词要处理，我创建了一个VBA代码来检查每个单元格的每个字符并格式化正确的单元格。您可以在下面找到我的代码。

Excel可以处理一些短语，然后窒息然后崩溃。我试图检查没有运气的原因。

其他时候，Excel将以不可预测的方式操作，例如复制前导字母或突出显示红色的其余部分。在比较公式栏中的文本值与单元格中可见的文本值时，可以看到差异

错误示例

如果保存并重新打开，这些有问题的单元格会破坏文件。

我的代码是否存在内在错误，或者Excel出于某种原因只是出错？是否有不同的方法来做到这一点，而不会导致excel有错误和损坏文件？

更新：运行建议代码的另一个错误示例

Sub Acronym_List_Formatting()
Dim cll As Range
Dim i As Long
Dim q As Integer
Dim Char As String
Dim UChar As String
Dim Phrase() As String

q = Application.InputBox("Set the base font size", Default:=12, Type:=1)

'| Set initial formatting of everything |'

With Selection.Font
    .Name = "Calibri"
    .Size = q
    .Bold = False
    .Color = vbBlack
End With

'| Main Code |'

For Each cll In Selection

ReDim Phrase(Len(cll.Value))

 For i = 1 To Len(cll.Value)

    Char = Mid$(cll.Value, i, 1)
    UChar = UCase$(Char)
    Phrase(i) = Char

   If Asc(UChar) >= 65 And Asc(UChar) <= 90 Then '|Asc returns the ASCII value ; Continues only if character is a letter|'

        If Char = UChar Then
            With cll.Characters(i, 1).Font
                    .Bold = True
                    .Size = .Size + 1.5
                    .Color = vbRed
            End With

        End If

   End If

   Next i

 'Debug.Print "Phrase: " & Join(Phrase)
 MsgBox ("Phrase: " & Join(Phrase, ""))

 Next cll

 End Sub

更新（2）：我的测试数据摘录

Amcom [航空和导弹指挥]工程理事会

c2BmC [指挥控制，战斗管理和通信]元素负责人

Bmds [弹道导弹防御系统] Opir [架空持续红外]架构

Jtids [联合战术信息发布系统]接口控制

北约[北大西洋公约组织]通用通信系统

Osf [目标模拟框架]公共接口

爱国者[相控阵跟踪雷达拦截目标]高级能力3模拟

爱国者[相控阵跟踪雷达拦截目标]反巡航导弹

爱国者[相位阵列跟踪雷达拦截目标]消防训练师的行为

RW []集成工具集

Sm-3 [标准导弹-3]合作开发

SPAWAR [Space＆amp;海军作战系统司令部]系统中心PACIFIC

THaad [终端高海拔地区防御]元素导致

Answer 1

如果您只需要识别和格式化大写字母，可以使用：

Option Explicit

Public Sub AcronymListFormatting()
    Dim fntSz As Variant, cll As Range, i As Long, char As String

    fntSz = Application.InputBox("Set the base font size", Default:=12, Type:=1)

    If fntSz <> False And fntSz > 7 Then    'validate user input and Cancel
        Application.ScreenUpdating = False
        With Selection.Font
            .Name = "Calibri"
            .Size = fntSz
            .Bold = False
            .Color = vbBlack
        End With
        For Each cll In Selection.Cells
            For i = 1 To Len(cll.Value2)
                char = Mid$(cll.Value2, i, 1)
                If Asc(char) >= 65 And Asc(char) <= 90 Then    'A-Z = 65-90, a-z = 97-122
                    With cll.Characters(i, 1).Font
                        .Bold = True
                        .Size = .Size + 1.5
                        .Color = vbRed
                    End With
                End If
            Next
        Next
        Application.ScreenUpdating = True
    End If
End Sub

转换为正确的情况：

cll.Value2 = WorksheetFunction.Proper(cll.Value2)

或

cll.Value2 = StrConv(cll.Value2, vbProperCase)

修改1

使用新数据进行测试：

修改2

问题（随机错误）是由从外部文件导入的损坏文本引起的，如P. McInturff的评论所示

根据大小写修改每个单元格每个单元格的单个字符的格式。 Excel随机错误

1 个答案: