删除删除线单元格并遍历所有表单

我试图从工作簿删除删除线的所有单元格，并同时在所有工作表上迭代。

我已经跟着这个 ， 这个和这个，并拿出两个macros，但他们不工作。 这是我第一次使用VBA，所以我不确定如何解决这些问题。

Sub DeleteCells() Dim Cell As Range, iCh As Integer, NewText As String Dim WS_Count As Integer Dim I As Integer ' Set WS_Count equal to the number of worksheets in the active ' workbook. WS_Count = ActiveWorkbook.Worksheets.Count ' Begin the loop. For I = 1 To WS_Count With Sheets(I) ' <~~ avoid select as much as possible, work directly with the objects Lrow = .Cells(.Rows.Count, "C").End(xlUp).Row For Each Cell In .Range("C1: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 Next I End Sub 

在这种情况下，我得到“无法获得字符类的文本属性”

 Sub LoopThroughAllTablesinWorkbook() Dim tbl As ListObject Dim sht As Worksheet For Each sht In ThisWorkbook.Worksheets With Sheets("sht") Lrow = .Cells(.Rows.Count, "C").End(xlUp).Row For Each Cell In .Range("C1: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 Next sht End Sub 

在这种情况下，我得到一个错误：下标超出范围，这是指与表格部分。

Answer 1

尝试这个

 Sub DeleteCells() Dim cel As Range Dim ws As Worksheet Dim lastRow As Long For Each ws In ActiveWorkbook.Worksheets 'loop through all sheets With ws lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'get last row with data using Column C For Each cel In .Range("C1:M" & lastRow) 'loop through all cells in range If cel.Font.Strikethrough Then 'check if cell has strikethrough property cel.Clear 'make cell blank and remove strikethrough property End If Next cel End With Next ws End Sub