xlDown不选择空白单元格

时间:2016-12-07 17:03:46

标签: excel vba excel-vba macros

我遇到的问题是某个特定列的某些行在其中间有空白。这是领导代码:

  

范围(FieldName.Offset(1),FieldName.End(xlDown))。选择

不选择所有细胞,因为它停留在空白细胞处,并在空白处之前填充XYZ中的细胞。

我知道xlup会解决这个问题,但是,如果该字段的最后一个单元格为空,那么它将不会更改该单元格并转到下一个填充的单元格。我不确定如何修改我的代码,以便它使用xlup并避免如果列中的底部单元格为空。我有一个名为" ABC"这将永远填充所有行,我可以ping掉,以便将其作为过滤数据的最后一行调用,但我不知道如何做到这一点。

我的代码

Sub SelectDown()

Dim FieldName As Range
Dim rng As Range, res As Variant, lrow As Long

Set rng = ActiveSheet.AutoFilter.Range.Rows(1)
res = Application.Match("Errors", rng, 0)

'Finds the Specific Error'
rng.AutoFilter Field:=res, Criteria1:="*-SHOULD BE XYZ*"

'Only Shows rows that have something that matches the filter criteria
lrow = ActiveSheet.Cells(Rows.Count, res).End(xlUp).Row + 1

If ActiveSheet.Range(Cells(1, res), Cells(lrow, res)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

    Set FieldName = Range("A1:BZ1").Find("COLUMN NAME")

    'If field isnt present shows message
    If FieldName Is Nothing Then
        MsgBox "Field Name was not found."
    End If

    'Changes the Selection to XYZ if there is a change present
    Range(FieldName.Offset(1), FieldName.End(xlDown)).Select
    Selection.FormulaR1C1 = "XYZ"
    'Changes the Color of the fields changed to Yellow
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
    End With
Else
End If

End Sub

1 个答案:

答案 0 :(得分:1)

您可以使用此代码 使用Set FieldName = Range("A1:BZ1").Find("COLUMN NAME")查找列号(提供它不是什么)并将其作为可选的色号提供。

Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With wrkSht
        If Col = 0 Then
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Else
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
        End If

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0

End Function