简体   繁体   中英

How to delete rows in excel if the cell in the first column isn't bold?

I have a list in excel with about 20000 rows and 4 columns. This excel sheet contains names in bold, and the columns after that have information about them. After each name there is some excess information that takes up either 3 or 4 rows, but it's not consistent. I need to run through the sheet and delete all the rows where there isn't a bold name.

You need to create a macro the finds out how many rows are in the current worksheet and that then iterates through the rows from the bottom of the worksheet to the top checking to see if the Font.Bold property on the first column of the row is set to false. If so you delete that row.

The following works for me:

Sub DeleteUnboldRows()
    Dim lastRow As Long
    Dim currentRow As Long

    'Select All the rows in the active worksheet
    lastRow = ActiveSheet.UsedRange.Rows.Count

    ' Iterate through each row from the bottom to the top.
    ' If we go the other way rows will get skipped as we delete unbolded rows!
    For currentRow = lastRow To 1 Step -1

        'Look at the cell in the first column of the current row
        ' if the font is not bolded delete the row
        If ActiveSheet.Rows(currentRow).Columns(1).Font.Bold = False Then
            ActiveSheet.Rows(currentRow).Delete
        End If
    Next currentRow
End Sub

Here is a reference for the Bold property: http://msdn.microsoft.com/en-us/library/office/aa224034%28v=office.11%29.aspx

Sub deleteNonBolded()

    Dim cell As Range
    Dim selectRange As Range

    For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
        If (cell.Font.Bold = False) Then
            If selectRange Is Nothing Then
                Set selectRange = cell
            Else
                Set selectRange = Union(cell, selectRange)
            End If
        End If
    Next cell

    selectRange.EntireRow.Delete

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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