2

完了したかどうかにかかわらず、列に「はい」または「いいえ」で示されているタスクの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の値に基づいて1つの範囲を単純に定義する方が簡単でしょうか。

ありがとう

4

2 に答える 2

3

はい列Hには、タスクが「到着」した日付があり、それから現在の日付までのカウントを表示したいと思います。タスクは、列Aの4桁のコードで識別されます。xx日間未処理のタスク「1234」というメッセージボックスを想定しています。–アリステア堰1分前

これはあなたがしようとしていることですか？視覚化のために列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 に答える