How to remove in-cell text with 0 values and start a new line for the text with non-zero values in Excel?

Please help resolve the below issues in Excel.

The original text value in one single cell: ABCD 0% #@x; EDFG 0% #@x; HIGK 5% #@x; LMNO 50% #@x; PQRS 90%; TUVW 0% #@x;

The target text value will be:
HIGK 5%
LMNO 50%
PQRS 90%

Note:#@x have to be removed, any 0% percentage and the text before it have to be removed, any non-0% percentages and the text before it have to be displayed, the result shows multiple rows but still within one single cell.

I tried to split the single cell into 6 columns by using delimiter ; then transpose the 6 columns to 6 rows, then further split the text and percentage numbers for each row, then delete the rows with 0%, and then merge the remaining non-zero rows. But the original cell is a single cell with a lot of other cells surrounded, transposing steps affect the surrounded cells.

Hope anyone could help with this issue by using Macro VBA script. Thanks a lot!

Without regex or vba:

Formula in A3:

Excel ms365:

=LET(x,TRIM(TEXTSPLIT(A1,{" #@x;",";"},,1)),TEXTJOIN(CHAR(10),,IF(-TEXTAFTER(x," ",-1)<0,x,"")))

Excel 2019:

{=TEXTJOIN(CHAR(10),,FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(A1,"#@x",),";","</s><s>")&"</s></t>","//s[not(contains(.,' 0%'))][node()]"))}

VBA:

If a regular expressions and an UDF is what you are after, then try:

\s*([^;]+\b[1-9]\d*%)

See an online demo for more explaination.

Public Function RegexMatch(s As String) As String

Static RE As Object: If RE Is Nothing Then Set RE = CreateObject("vbscript.regexp")

RE.Pattern = "\s*([^;]+\b[1-9]\d*%)"
RE.Global = True

Set REMatches = RE.Execute(s)
If REMatches.Count > 0 Then
    For Each Match In REMatches
        If RegexMatch = "" Then
            RegexMatch = Match.Submatches(0)
        Else
            RegexMatch = RegexMatch & Chr(10) & Match.Submatches(0)
        End If
    Next
Else
    RegexMatch = vbNullString
End If

End Function

Call this through:

=RegexMatch(A1)

This should work:

Function removeZero(ByVal val As String) As String
    Dim intermediate As String
    For Each x In Split(val, ";")
        If x <> "" Then
            intermediate = ""
            For Each y In Split(x, " ")
                intermediate = intermediate & " " & y
                If Right(y, 1) = "%" Then
                    If Left(y, Len(y) - 1) <> "0" Then
                        removeZero = removeZero & Trim(intermediate) & vbLf
                        Exit For
                    End If
                End If
            Next y
        End If
    Next x
End Function

after looking at JvdV's answer, I realized I could probably just do this:

Function removeZero(ByVal val As String) As String
    For Each x In Split(val, ";")
        If x <> "" Then
            If InStr(x, " 0%") = 0 Then
                removeZero = removeZero & Replace(Trim(x), " #@x", "") & vbLf
            End If
        End If
    Next x
End Function

Both of these functions will work, the first one is a little silly though.

result:

Wrap text must be enabled for the linebreaking to work.

*if you have newer version of Excel, this might be possible with built-in functions but I'm on Excel 2010 so this is the best I can do.