使用vba刪除范圍中的刪除線單元格

Question

我在表格中有500行和大約13列數據。

我需要刪除單元格內容本身，即使單元格包含所有字符作為刪除，但如果單元格包含一些文本和刪除的組合，它應該刪除單獨的刪除並將剩余的文本留在單元格中。

這是我的excel的樣子

  A      B               C   D   E   F   G   H   I   J   K    L       M
 1.2   SERVER_P                  RE1                        **GR5** 
 7.3   PROXY NET
 4.5   NET **CON** V1                            GR

如果**中的文本是預期的，我希望在第1行中列L應該為空，在第3行中它應該刪除CON，因此它應該保持“NET V1”。

這就是我現在所擁有的

Dim Cell As Range
Dim iCh As Integer
Dim NewText As String
Sheets("Copy_indications").Select

With ActiveSheet
     'count the rows till which strings are there
     Lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

For Each Cell In Range("B1:M" & Lrow)
     For iCh = 1 To Len(Cell)
        With Cell.Characters(iCh, 1)
           If .Font.Strikethrough = False Then
              NewText = NewText & .Text
           End If
        End With
     Next iCh
 NewText = Cell.Value
 Cell.Characters.Font.Strikethrough = False
Next Cell

如果單元格包含某些文本和刪除線的組合，我的宏將刪除所有刪除線字符，但如果單元格包含所有字符作為刪除線，則它不會刪除它們而是刪除它們的刪除。

有人可以幫我這個嗎？

Answer 1

好的解決方案，只是糾正了一些錯誤（參見代碼中的注釋）

Dim Cell As Range, iCh As Integer, NewText As String

With Sheets("Copy_indications") ' <~~ avoid select as much as possible, work directly with the objects

    Lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
    For Each Cell In .Range("B1:M" & Lrow)
        For iCh = 1 To Len(Cell)
             With Cell.Characters(iCh, 1)
                 If .Font.Strikethrough = False Then NewText = NewText & .Text
            End With
        Next iCh
        Cell.Value = NewText ' <~~ You were doing it the other way around
        NewText = "" ' <~~ reset it for the next iteration
        Cell.Characters.Font.Strikethrough = False
    Next Cell

End With