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

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

在這種情況下，我得到“無法獲得Character類的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