如何在 Excel 中使用 VBA 根据换行符过滤单个单元格中的行？

Question

I have this cell (and a whole column of similar cells) containing part numbers and their statuses and I need to filter out the numbers marked complete while retaining the rest.

I know there's a way to separate the information based on the line breaks but after that I'm at a loss. I've tried creating an array from the cell but the array makes it difficult to remove information.

I feel like there's a simple solution to this but I'm just not seeing it. *Edit- I'm using Excel 2016 so I don't have a lot of the newer functions.

Answer 1

Try this formula (data is in cell A1):

=LET(XML, "<t><s>" & SUBSTITUTE(A1,CHAR(10),"</s><s>") & "</s></t>",
          Data, FILTERXML(XML,"//s"),
          FILTER(Data,NOT(ISNUMBER(SEARCH("Complete",Data)))))  

or if you want it returned in a single cell:

=TEXTJOIN(CHAR(10),TRUE,
          LET(XML, "<t><s>" & SUBSTITUTE(A1,CHAR(10),"</s><s>") & "</s></t>",
                 Data, FILTERXML(XML,"//s"),
                 FILTER(Data,NOT(ISNUMBER(SEARCH("Complete",Data))))))

Answer 2

colArray = Array("H")
        check_col = colArray(0)
        ColLastRow = Range(check_col & Rows.Count).End(xlUp).Row
        For Each Rng In Range(check_col & "1" & ":" & check_col & ColLastRow)
            If InStr(Rng.Value, vbLf) Then
                Rng.EntireRow.Copy
                Rng.EntireRow.Insert
                
                For i = 0 To UBound(colArray)
                    c = colArray(i)
                    
                    Set currentrng = Range(c & Rng.Row)
                    Set upperRng = currentrng.Offset(-1, 0)
                
                    upperRng.Value = Mid(currentrng.Value, 1, InStr(currentrng.Value, vbLf) - 1)
                    currentrng.Value = Mid(currentrng.Value, Len(upperRng.Value) + 2, Len(currentrng.Value))
                Next i
            End If
        Next

This is what I ended up using. Split the cells into separate rows so That I could filter. Then I used the following code to recombine.

Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
            For i = Last_Row To 2 Step -1
            
                If Len(Cells(i, 1)) = 0 Then Rows(i).Delete
                    If Cells(i, 6) = Cells(i - 1, 6) Then
                        Cells(i - 1, 9) = Cells(i - 1, 9) & vbLf & Cells(i, 9)
                        Rows(i).Delete
                    End If
                
            Next i