单元格值为空白的范围循环

Question

我已经设置了一个范围。该范围内的一些单元格有值，而许多单元格没有值，它们是空白的。我有一个需要时间的范围循环，因为它处理每个单元格：

For Each cel1 In rngsh1

上面处理了范围内的所有单元格。

范围循环仅处理非空白单元格的确切语法是什么？

For Each cel11 in rngsh1 and not nothing 之类的东西我知道这种语法是错误的，但我正在寻找一个正确的。

Answer 1

类似这样的：

Dim cel11 As Range
Dim rngsh1 As Range

'Function MultiOr(str As String, ParamArray arr() As Variant) As Boolean
'  Dim holder, runner
'  MultiOr = True
'  For Each holder In arr 'look for everything in arr
'    If IsArray(holder) Then 'if what you found is an array
'      For Each runner In holder 'for everything in that array
'        If MultiOr(str, runner) Then Exit Function 
'      Next
'    Else 'if its no array
'      If Not IsMissing(holder) Then If holder = str Then Exit Function
'    End If
'  Next
'  MultiOr = False
'End Function

Sub MySub()
  For Each cel1 In Range
'   If Not IsEmpty(cel1.Value) Then 'see EEM's answer
    If Len(cel1.Value) > 0 Then 
'     If MultiOr(cel1.Value, condi) Then 'no need for this function 
      If Not IsError(Application.Match(cel1.Value, Range("I1:BJ1"), 0)) Then
        'your code here
      End If
    End If
  Next
End Sub

'`condi` can be a range with all the conditions or an array or simply a value...

Answer 2

要真正搜索非空白单元格，需要使用 SpecialCells 范围方法（请参阅Range.SpecialCells Method (Excel)

这个程序只处理非空白单元格

由于该过程中使用的某些资源对用户来说可能是新的，因此我建议访问Select Case Statement，但如果您对代码有任何疑问，请告诉我。

Sub Search_NonBlank_Cells()
Dim Rng As Range
Dim rCll As Range

    Rem Set Range
    Set Rng = ActiveSheet.Range(kRng)

    Rem Ensure blank intended cells are actually blank
    Rng.Value = Rng.Value2

    Rem Loop Through Non-Blank Cells Only
    For Each rCll In Rng.SpecialCells(xlCellTypeConstants, _
        xlErrors + xlLogical + xlNumbers + xlTextValues)

        Rem Validate if cell value starts with "center"
        If Left(rCll.Value2, 6) = "center" Then
            Rem Validate if remaining cell value is between 1 to 54
            Select Case Application.Substitute(rCll.Value2, "center", "")
            Case 1 To 54
                Rem Process Cell Found
                rCll.Interior.Color = RGB(255, 255, 0)

    End Select: End If: Next

End Sub

这是相同的过程，包括一些有助于调试和理解过程的行，还会在即时窗口中生成日志。

Sub Search_NonBlank_Cells_Debug()
Dim Rng As Range
Dim rCll As Range

: SendKeys "^g^a{DEL}": Stop
: Debug.Print vbLf; Now
: Debug.Print "Address"; Tab(11); "Cll.Value"; Tab(31); "Status"

    Rem Set Range
    Set Rng = ActiveSheet.Range(kRng)

    Rem Ensure blank intended cells are actually blank
    'i.e. Cells with formulas results as "" are not blank cell this makes then blank cells
    Rng.Value = Rng.Value2

    Rem Loop Through Non-Blank Cells Only
    For Each rCll In Rng.SpecialCells(xlCellTypeConstants, _
        xlErrors + xlLogical + xlNumbers + xlTextValues)

: Debug.Print rCll.Address; Tab(11); rCll.Value2;

        Rem Validate if cell value starts with "center"
        If Left(rCll.Value2, 6) = "center" Then
            Rem Validate if remaining cell value is between 1 to 54
            Select Case Application.Substitute(rCll.Value2, "center", "")

            Case 1 To 54
                Rem Process Cell Found
: Debug.Print Tab(31); "Processed"
                rCll.Interior.Color = RGB(255, 255, 0)

            Case Else
: Debug.Print Tab(31); "Skipped"

            End Select
        Else
: Debug.Print Tab(31); "Skipped"

    End If: Next

End Sub