从任务列表中自动创建艾森豪威尔矩阵

时间:2017-02-03 14:02:01

标签: excel vba excel-vba matrix

我正在尝试使用VBA自动创建Excel中的待办事项列表来创建Eisenhower matrix

我已按以下方式构建了我的待办事项列表:

Task | Urgent | Important | done
 T1  |   x    |    x      |  
 T2  |        |    x      |  
 T3  |   x    |           |  
 T4  |        |           |  

我能够在紧急程度和重要性上过滤我的任务列表,并排除表示为"完成"的行。

我想以这样的方式创建我的矩阵:

__________|IMPORTANT|NOT IMPORTANT
URGENT    |   T1    |     T3
----------|---------|--------------
NOT URGENT|   T2    |     T4

我不知道如何编写我的VBA代码,以便选择我过滤的行,确定矩阵的大小,并相应地填充它。

我正在尝试使用excel VBA中的range.count()属性来计算行数,但我无法使T2和T4对齐。此外,它复制了“任务”'每次都是标题。

我到目前为止的代码如下:

Sub populate_matrix()
Dim i As Integer

ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=5, Criteria1:="="
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=2, Criteria1:="<>"
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=3, Criteria1:="<>"

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
i = Range(Selection).Count
Selection.Copy
Sheets("work matrix").Select
Range("B2").Select
ActiveSheet.Paste

Sheets("tasks").Select
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=5, Criteria1:="="
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=2, Criteria1:="<>"
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=3, Criteria1:="="

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("work matrix").Select
Range("B" & i).Select
ActiveSheet.Paste

Sheets("tasks").Select
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=5, Criteria1:="="
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=2, Criteria1:="<>"
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=3, Criteria1:="="

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("work matrix").Select
Range("c2").Select
ActiveSheet.Paste

Sheets("tasks").Select
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=5, Criteria1:="="
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=2, Criteria1:="="
ActiveSheet.Range("$A$1:$E$55").AutoFilter Field:=3, Criteria1:="="

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("work matrix").Select
Range("C" & i).Select
ActiveSheet.Paste

End Sub

1 个答案:

答案 0 :(得分:0)

在OP的代码更新后编辑

你可以试试这个

Option Explicit

Sub main2()
    Dim EisenTable As Range

    Set EisenTable = Worksheets("work matrix").Range("B2:C3")
    With Worksheets("tasks")
        With .Range("D1", .Cells(.Rows.Count, "A").End(xlUp))
            EisenTable.Cells(1, 1) = CountX(.Cells, 2, 3, "x", "x")
            EisenTable.Cells(1, 2) = CountX(.Cells, 2, 3, "x", "<>x")
            EisenTable.Cells(2, 1) = CountX(.Cells, 2, 3, "<>x", "x")
            EisenTable.Cells(2, 2) = CountX(.Cells, 2, 3, "<>x", "<>x")
        End With
    End With
End Sub

Function CountX(rng As Range, col1 As Long, col2 As Long, crit1 As String, crit2 As String) As String
    Dim cell As Range
    Dim iVal As Long

    With rng
        .AutoFilter Field:=col1, Criteria1:=crit1
        .AutoFilter Field:=col2, Criteria1:=crit2
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            With .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)
                ReDim vals(1 To .Count) As String
                For Each cell In .Cells
                    iVal = iVal + 1
                    vals(iVal) = cell.Value
                Next
            End With
            CountX = Join(vals, ",")
        End If
        .Parent.AutoFilterMode = False
    End With
End Function