Question

我有一个已完成或未完成的任务的excel文件，由列中的“是”或“否”表示。最后，我对不同列中的数据感兴趣，但我想设置代码，以便忽略已完成任务的那些行。到目前为止，我已经定义了包含yes / no的列范围，但我不知道在此范围内运行哪个命令。我想我想根据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

是列H具有任务“到达”的日期，我想显示从那时到当前日期的计数。任务由A列中的4位数代码识别。我设想消息框说明任务'1234'在xx天内未完成。 - Alistair Weir 1分钟前

这是你在尝试什么？添加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

<强>快照

enter image description here

Answer 2

为什么不蛮力。

Dim r_table as Range, i as Integer, N as Integer
' Start from the top
Set r_table = Sheets("2011").Range("C1")
' Find the last entry on column C and count the # of cells
N = Sheets("2011").Range(r_table, r_table.End(xlDown)).Rows.Count
Dim table_values() as Variant
' This will transfer all the values from the spreadsheet into an VBA array
' and it works super fast. Access values with A(row,col) notation.
table_values = r_table.Resize(N, 5).Value2   ' No. of columns is 5 ?

For i=1 to N
    If table_values(i,1)="Yes" Then   'Check Column C
    Else
       ... table_values(i,5)   ' Column H

    End if
Next i
MsgBox ....

这将超级快，屏幕上没有闪烁。

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

2 个答案: