別の範囲の値から範囲を定義する

Question

完了したかどうかを示すExcelファイルがあります。これは、列に「はい」または「いいえ」と表示されます。最終的に私は別の列のデータに興味がありますが、タスクが完了した行を無視するようにコードを設定したいと思います。これまでのところ、yes/noを含む列範囲を定義しましたが、この範囲で実行するコマンドはわかりません。私は

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の値に基づいて1つの範囲を定義する方が簡単ではなく、最初の範囲としてC列を定義するだろう、列Cの値に基づいて新しい範囲を定義したいと想像しますそれを再定義しますか？

おかげ

Answer 1

はい列Hは、日付にタスクを持っている「到着」と私はその後から現在の日付までのカウントを表示したいです。タスクは列Aの4桁のコードによって識別されます。タスク '1234'未処理のxx日を示すメッセージボックスを想定します。 - 分前アリスター・ウィアー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 

SNAPSHOT

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

これは、画面上にちらつきがなく、超高速になります。