Defining a range from values in another range

烈酒焚心 提交于 2019-12-13 16:53:33

问题


I have an excel file of tasks which have either been completed or not, indicated by a Yes or No in a column. Ultimately I am interested in data in a different column but I want to set up the code so it ignores those rows where the task has been completed. So far I have defined the column range containing the yes/no's but I don't know which command to run on this range. I imagine I want to define a new range based on the value in column 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

Would it perhaps be easier to simply define one range based on the values in column C rather than first defining column C as the range and then redefining it?

Thanks


回答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

Is this what you are trying? Added Col I for visualization purpose. It holds no significance otherwise.

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




回答2:


Why not brute force it.

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

This will be super fast, with no flicker on the screen.



来源:https://stackoverflow.com/questions/10322726/defining-a-range-from-values-in-another-range

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!