批量修改选定单元格中特定字符为斜体下表或上标，运行极不稳定，啥原因？

zhg19680121

Application.ScreenUpdating= True '禁用屏幕自动刷新，提高运行效率

    Dim rng As Range

    Dim cell As Range

    Dim charToFind As String

    Dim replacement As String

    Dim startPion As Long

   

    Dim filename As String

     filename = "c:\file.txt"

     Open filename For Output As #1

   

   

   

   

   

   

    Set rng = Selection

   

   

    For Each cell In rng

   

        charToFind = "Urel="

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value, charToFind)

        If startPion > 0 Then

            '

            

            cell.Characters(startPion,1).Font.Italic = True

            cell.Characters(startPion + 1,3).Font.Subscript = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  Urel="

        End If

        

        charToFind = "Ur="

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value,charToFind)

        If startPion > 0 Then

            '

            cell.Characters(startPion,1).Font.Italic = True

            cell.Characters(startPion + 1,1).Font.Subscript = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  Ur="

        End If

        

        charToFind = "U="

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value,charToFind)

        If startPion > 0 Then

            '

            cell.Characters(startPion,1).Font.Italic = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  U="

        End If

        

        charToFind = "k="

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value,charToFind)

        If startPion > 0 Then

            '

            cell.Characters(startPion,1).Font.Italic = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  k="

        End If

        

        

        charToFind = "m3/h"

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value,charToFind)

        If startPion > 0 Then

            '

            cell.Characters(startPion + 1,1).Font.Superscript = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  m3/h"

        End If

        

        

        charToFind = "×10"

        ' 检查单元格是否包含指定字符

        startPion = InStr(cell.Value,charToFind)

        If startPion > 0 Then

            '

            cell.Characters(startPion + 4,2).Font.Superscript = True

            

            Print #1, cell.Value &":" & Chr(13) & cell.Row & "，" & cell.Column & "  ×10"

            

        End If

    Next cell

   

   

    Application.ScreenUpdating = False

    Close #1

蓝桥玄霜

没有附件不能测试代码。
建议上传Excel表格附件来说明问题。

zhg19680121

发上问题样例

zhg19680121

蓝桥玄霜 发表于 2024-3-30 10:34
没有附件不能测试代码。
建议上传Excel表格附件来说明问题。

https://club.excelhome.net/forum.php?mod=attachment&aid=Mjk5ODIyOXwxZjA5MzVjOHwxNzExOTAyMzA1fDQ3Mjg4ODB8MTY4ODQ3NA%3D%3D&mobile=2

zhg19680121

找到了问题：所选区域存在强制换行符，删除该符号，运行稳定。可是为什么呢？

zhg19680121

还有什么可能的符号会影响这段程序呢？

zhg19680121

zhg19680121 发表于 2024-3-30 18:20
发上问题样例

找到了问题：所选区域存在强制换行符，删除该符号，运行稳定。可是为什么呢？