刪除刪除線單元並遍歷所有工作表

Question

我試圖從工作簿中刪除帶刪除線的所有單元，並在所有工作表上同時迭代所有單元。

我跟着this，this和this，並拿出兩個宏，但他們不工作。這是我第一次使用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 

在這種情況下，我得到「無法獲得字符類的Text屬性」

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