vbaを使用して範囲内の取り消し線セルを削除します

Question

シートに500行と約13列のデータがあります。

セルにすべての文字がストライクスルーとして含まれていてもセルの内容自体を削除する必要がありますが、セルにテキストとストライクスルーの組み合わせが含まれている場合は、ストライクスルーを単独で削除して残りセル内のテキスト。ここで

は**内のテキストは、裏抜け、私は期待して、第一行の列Lが空であるべきで、3行目では、それはCONを削除する必要があるので、それが必要ならば、私の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 

どのように見えるかです「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

良い解決策は、単に（コード内のコメントを参照してください）ヘルプの@ A.S.Hため

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