在列中找到区分空单元格和空单元格的列

时间:2012-08-21 14:12:19

标签: excel vba

我需要在列中找到第一个单元格,该单元格为空或仅包含空格。我想出了以下内容..

Dim FindString As String
Dim Rng As Range
Dim Done As Boolean

FindString = ""
With Sheets("Yahoo").Range("A:A")
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells([Stock_Start_Row], 1), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        j = Rng.Row
        Done = False
        Do Until Done
            FindString = .Cells(j, 1)
            FindString = Replace(FindString, " ", "")
            If FindString = "" Then
                j = j - 1
            Else
                Done = True
            End If
        Loop

        MsgBox "Found" & " " & Rng.Row & " " & j
    Else
        MsgBox "Nothing found"
    End If
End With

这将在第一个空单元格之前发现并清除任何空白单元格,但不会在前面的单元格中发现空白单元格。

有没有办法搜索包含一个或多个空格的单元格?

如果是这样,我可以添加第二次搜索。

1 个答案:

答案 0 :(得分:0)

  

我需要在列中找到空的或第一个单元格   只包含空白。

这将通过工作表(“Yahoo”)上的A列。它应该适合你:

Sub FindBlankOrEmptyCells()
Dim wbk As Workbook
Set wbk = ThisWorkbook

Dim ws As Worksheet
Set ws = wbk.Sheets(1)

Dim cell As Range

Dim BlankCounter As Integer
Dim i As Integer
Dim OldCellValue As Variant ' just for the heck of it

For Each cell In Sheets("Yahoo").Range("A:A")
    OldCellValue = cell.Value
    cell.NumberFormat = "@"
    cell.Value = "'" & cell.Value

    BlankCounter = 0

    If cell.Value = "" Then
        MsgBox "Found an empty cell in Column A, Row: " & " " & cell.Row
        Exit Sub
    End If

    For i = 1 To Len(cell)
        If cell.Characters(i, 1).Text = " " Then
            BlankCounter = BlankCounter + 1
        End If

        If BlankCounter = Len(cell) Then
            MsgBox "Found a cell full of blanks in Column A, Row: " & " " & cell.Row

                cell.Clear
                cell.Value = OldCellValue
                cell.Value = cell.Value

            Exit Sub
            ' If you want to delete the contents of the cell or continue looping you can delete this Exit Sub and put in:
            ' cell.ClearContents
            ' then it will loop through all the cells and delete blanks and message you each time
        End If
    Next i

    cell.Clear
    cell.Value = OldCellValue
    cell.Value = cell.Value

Next cell

End Sub

这将找到第一个为空或仅包含空格(空格)的单元格。一旦找到符合该标准的单元格,它就会停止。如果要继续循环,可以启用我注释掉的代码。让我知道它是如何工作的。

编辑:

如果你想使用.find函数来获得一些可能的效率 - 但最终你需要循环遍历单元格中的所有字符并确定它是否包含所有空格。尝试这一个(我在第30行停止它,所以它不会继续弹出空白消息 - 但你可以删除消息并扩展到循环直到第999999行):

Sub FindBlankOrEmptyCellsWithFindFunction()
Dim FindString As String
Dim Rng As Range
Set Rng = Sheets("Yahoo").Range("A1")
Dim Done As Boolean

Dim wbk As Workbook
Set wbk = ThisWorkbook

Dim ws As Worksheet
Set ws = wbk.Sheets(1)

Dim cell As Range

Dim BlankCounter As Integer
Dim i As Integer
Dim ii As Integer
Dim LoopStopperRange As Range
Dim OldCellValue As Variant

ii = 0

Do
    ii = ii + 1
    FindString = " "
    With Sheets("Yahoo").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(Rng.Row, 1), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then ' If Rng Is Something Then
            If ii = 1 Then
                Set LoopStopperRange = Rng
            End If
            If LoopStopperRange = Rng And ii > 1 Then
                Exit Do
            End If
            For Each cell In Rng
                OldCellValue = cell.Value
                cell.NumberFormat = "@"
                cell.Value = "'" & cell.Value

                BlankCounter = 0

                If cell.Value = "" Then
                    MsgBox "Found an empty cell in Column A, Row: " & " " & cell.Row
                    'Exit Sub
                End If

                For i = 1 To Len(cell)
                    If cell.Characters(i, 1).Text = " " Then
                        BlankCounter = BlankCounter + 1
                    End If

                    If BlankCounter = Len(cell) Then
                        MsgBox "Found a cell full of blanks in Column A, Row: " & " " & cell.Row

                            cell.Clear
                            cell.Value = OldCellValue
                            cell.Value = cell.Value

                        'Exit Sub
                        ' If you want to delete the contents of the cell or continue looping you can delete this Exit Sub and put in:
                        ' cell.ClearContents
                        ' then it will loop through all the cells and delete blanks
                    End If

                Next i

                cell.Clear
                cell.Value = OldCellValue
                cell.Value = cell.Value

            Next cell
         Else
        End If
    End With
Loop Until Rng Is Nothing

Set Rng = Sheets("Yahoo").Range("A1")

Do
    ii = ii + 1
    FindString = ""
    With Sheets("Yahoo").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(Rng.Row, 1), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then ' If Rng Is Something Then
            For Each cell In Rng
                OldCellValue = cell.Value
                cell.NumberFormat = "@"
                cell.Value = "'" & cell.Value

                BlankCounter = 0

                If cell.Value = "" Then
                    MsgBox "This loop will go until Row 30 so you don't have to pause/break out. Found an empty cell in Column A, Row: " & " " & cell.Row
                    'Exit Sub
                End If

            Next cell
         Else
        End If
    End With
Loop Until Rng.Row = 30
'Loop Until Rng.Row = 99999

End Sub

祝你好运。