简体   繁体   English

使用vba删除范围中的删除线单元格

[英]delete the strikethrough cells in a range using vba

I have 500 rows and around 13 columns of data in a sheet. 我在表格中有500行和大约13列数据。

I need to delete the cell contents itself even if the cell contains all the characters as strike-through, but if the cell contains combination of some text and strike-through it should delete the strike-through alone and leave the remaining text in the cell. 我需要删除单元格内容本身,即使单元格包含所有字符作为删除,但如果单元格包含一些文本和删除的组合,它应该删除单独的删除并将剩余的文本留在单元格中。

Here is how my excel looks like 这是我的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

If text inside ** are strike-through I expect, in 1st row column L should be empty and in 3rd row it should delete CON , so it should remain "NET V1". 如果**中的文本是预期的,我希望在第1行中列L应该为空,在第3行中它应该删除CON,因此它应该保持“NET V1”。

Here is what I have till now 这就是我现在所拥有的

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

My macro deletes all the strike-through characters if the cell contains combination of some text and strike-through, but if the cell contains all the characters as strike-through, it does not delete them instead it removes the strike from them. 如果单元格包含某些文本和删除线的组合,我的宏将删除所有删除线字符,但如果单元格包含所有字符作为删除线,则它不会删除它们而是删除它们的删除。

Could someone help me with this. 有人可以帮我这个吗?

Good solution, just corrected a few mistakes (see comments in the code) 好的解决方案,只是纠正了一些错误(参见代码中的注释)

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM