Excel VBA代码优化：删除J列指定形状并替换空格为黑色箭头

以下是满足需求且修复了文本颜色误改问题的完整代码：

Sub RemoveArrowsAndReplaceSpaces()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim cell As Range
    Dim lastRow As Long
    Dim originalColor As Long
    Dim cellText As String
    Dim pos As Integer
    
    ' 定位到目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 删除J列内线条末端箭头样式为2的形状
    For Each shp In ws.Shapes
        ' 筛选线条类型、末端箭头样式为2，且位于J列的形状
        If shp.Type = msoLine And shp.Line.EndArrowheadStyle = msoArrowheadStyle2 Then
            If shp.TopLeftCell.Column = 10 Then ' J列对应序号10
                shp.Delete
            End If
        End If
    Next shp
    
    ' 处理J列非空单元格的文本格式
    lastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
    For Each cell In ws.Range("J1:J" & lastRow)
        If Not IsEmpty(cell.Value) Then
            ' 保存单元格原有字体颜色
            originalColor = cell.Font.Color
            
            ' 清除多余空格：先去首尾，再循环替换中间连续空格为单个
            cellText = Trim(cell.Value)
            Do While InStr(cellText, "  ") > 0
                cellText = Replace(cellText, "  ", " ")
            Loop
            
            ' 替换空格为向右箭头
            cellText = Replace(cellText, " ", ChrW(8594))
            cell.Value = cellText
            
            ' 仅将箭头字符设为黑色，原有文本恢复原始颜色
            cell.Font.Color = originalColor
            pos = InStr(cell.Value, ChrW(8594))
            Do While pos > 0
                cell.Characters(pos, 1).Font.Color = vbBlack
                pos = InStr(pos + 1, cell.Value, ChrW(8594))
            Loop
        End If
    Next cell
End Sub

关键修复说明 #

1. 避免文本颜色误改：
   • 先保存每个单元格的原始字体颜色originalColor
   • 处理完文本替换后，先将整个单元格字体恢复为原始颜色，再单独把新增的向右箭头字符设置为黑色，确保原有文本颜色完全不变。
2. 精准清理形状：增加了形状所在列的判断，只删除J列范围内符合条件的箭头线条，避免误删其他区域的形状。
3. 彻底清除多余空格：通过循环替换彻底消除单元格内的连续空格，再将单个空格替换为箭头。
4. 仅处理非空单元格：通过Not IsEmpty(cell.Value)跳过空单元格，提升处理效率。

内容的提问来源于stack exchange，提问作者Zion ToDo