excel - 从另一个范围中的值定义一个范围

Question

我有一个 Excel 文件，其中包含已完成或未完成的任务，并在列中用"is"或“否”表示。最终，我对不同列中的数据感兴趣，但我想设置代码，以便它忽略任务已完成的那些行。到目前为止，我已经定义了包含是/否的列范围，但我不知道在此范围上运行哪个命令。我想我想根据 C 列中的值定义一个新范围。

Option Explicit

Sub Notify()
    Dim Chk As Range
    Dim ChkLRow As Long
    Dim WS1 As Worksheet

    On Error GoTo WhatWentWrong

    Application.ScreenUpdating = False

    '--> If the text in column C is Yes then Ignore (CountIF ?)
    '--> Find last cell in the column, set column C range as "Chk"

    Set WS1 = Sheets("2011")

    With WS1
        ChkLRow = .Range("C" & Rows.Count).End(xlUp).Row
        Set Chk = .Range("C1:C" & ChkLRow)
    End With

    '--> Else Check date in column H
    '--> Count days from that date until today
    '--> Display list in Message Box
Reenter:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
WhatWentWrong:
    MsgBox Err.Description
    Resume Reenter
    Application.ScreenUpdating = True
End Sub

根据 C 列中的值简单地定义一个范围，而不是首先将 C 列定义为范围，然后重新定义它，是否会更容易？

谢谢

Answer 1

Yes Column H has the date the task 'arrived' and I want to display a count from then to the current date. The tasks are identified by a 4 digit code in Column A. I envisage the message box saying Task '1234' outstanding for xx days. – Alistair Weir 1 min ago

这就是你正在尝试的吗？添加 Col I 用于可视化目的。否则它没有任何意义。

Option Explicit

Sub Notify()
    Dim WS1 As Worksheet
    Dim Chk As Range, FltrdRange As Range, aCell As Range
    Dim ChkLRow As Long
    Dim msg As String
    On Error GoTo WhatWentWrong

    Application.ScreenUpdating = False

    Set WS1 = Sheets("2011")

    With WS1
        ChkLRow = .Range("C" & Rows.Count).End(xlUp).Row

        '~~> Set your relevant range here
        Set Chk = .Range("A1:H" & ChkLRow)

        '~~> Remove any filters
        ActiveSheet.AutoFilterMode = False

        With Chk
            '~~> Filter,
            .AutoFilter Field:=3, Criteria1:="NO"
            '~~> Offset(to exclude headers)
            Set FltrdRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
            '~~> Remove any filters
            ActiveSheet.AutoFilterMode = False

            For Each aCell In FltrdRange
                If aCell.Column = 8 And _
                Len(Trim(.Range("A" & aCell.Row).Value)) <> 0 And _
                Len(Trim(aCell.Value)) <> 0 Then
                    msg = msg & vbNewLine & _
                          "Task " & .Range("A" & aCell.Row).Value & _
                          " outstanding for " & _
                          DateDiff("d", aCell.Value, Date) & "days."
                End If
            Next
        End With
    End With

    '~~> Show message
    MsgBox msg
Reenter:
    Application.ScreenUpdating = True
    Exit Sub
WhatWentWrong:
    MsgBox Err.Description
    Resume Reenter
End Sub

快照