2

我有一个 Excel 文件，其中包含已完成或未完成的任务，在列中用“是”或“否”表示。最终我对不同列中的数据感兴趣，但我想设置代码以便它忽略那些已完成任务的行。到目前为止，我已经定义了包含是/否的列范围，但我不知道在这个范围上运行哪个命令。我想我想根据 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 列定义为范围然后重新定义它可能更容易吗？

谢谢

4

2 回答 2

3

是的，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

快照

在此处输入图像描述

于 2012-04-25T20:29:05.157 回答
0

为什么不暴力破解呢。

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 ....

这将非常快，屏幕上没有闪烁。

于 2012-04-25T20:30:57.220 回答