Excel：移除单元格内含0%的文本，保留非零值并换行显示（求VBA宏）

以下是直接满足需求的VBA脚本，可处理指定单元格的文本，自动过滤含0%的条目、移除#@x标记，并将结果在同一单元格内换行显示：

Sub FilterNonZeroPercent()
    Dim targetCell As Range
    Dim originalText As String
    Dim textParts() As String
    Dim filteredParts As Collection
    Dim part As Variant
    Dim resultText As String
    
    ' 手动选择目标单元格，灵活适配不同位置的单元格
    Set targetCell = Application.InputBox("选择要处理的单元格", Type:=8)
    originalText = targetCell.Value
    
    ' 按分号拆分原始文本
    textParts = Split(originalText, ";")
    
    Set filteredParts = New Collection
    
    ' 遍历每个拆分后的文本段
    For Each part In textParts
        part = Trim(part)
        ' 跳过空内容和包含0%的条目
        If part <> "" And InStr(1, part, "0%", vbTextCompare) = 0 Then
            ' 移除#@x标记并清理多余空格
            part = Replace(part, "#@x", "")
            part = Trim(part)
            filteredParts.Add part
        End If
    Next part
    
    ' 将筛选后的内容用换行符连接
    For Each part In filteredParts
        If resultText = "" Then
            resultText = part
        Else
            resultText = resultText & vbCrLf & part
        End If
    Next part
    
    ' 写入结果并开启自动换行
    targetCell.Value = resultText
    targetCell.WrapText = True
End Sub

使用步骤： #

• 打开目标Excel文件，按下Alt + F11打开VBA编辑器
• 右键点击左侧的工作簿名称，选择「插入」→「模块」
• 将上面的代码粘贴到模块窗口中
• 按下F5运行宏，或回到Excel界面，通过「开发工具」→「宏」选择FilterNonZeroPercent执行
• 弹出对话框后，点击需要处理的目标单元格即可完成操作

代码说明： #

• 支持手动选择目标单元格，避免固定单元格的局限性
• 自动跳过拆分后产生的空文本段（适配原始文本末尾的分号）
• 不区分大小写判断0%，确保所有含0%的条目都被过滤
• 处理后自动开启单元格自动换行，保证结果正常显示

内容的提问来源于stack exchange，提问作者MMM KKK