查找数据时返回文本

Question

我有一个电子表格，如下所示：

Name      Task              Date
Mike      Go to the beach   10/1/13
Mike      Go Shopping       10/2/13
Mike      Go to work        10/3/13
Bill      Go Hiking         10/1/13
Bill      Go to work        10/3/13

我正在尝试为电子表格构建另一个标签，该标签将查看数据标签，并在行和列匹配时返回匹配的文本值。

我正在尝试使用公式创建一种数据透视表。

结果应如下所示：

Name  10/1/13          10/2/13      10/3/13
Mike  Go to the beach  Go shopping  Go to work
Bill  Go Hiking       *Blank*       Go to work

我试图发布图片，但不能，因为这是我的第一篇文章。 我希望你能理解我的要求。

Answer 1

我不是数据透视表的专家，我用愚蠢的方式做到了 - 但是有效。假设：

1）源数据始终在“Sheet1”上，包含3个列标题

2）“Sheet2”将用于存储已排序的数据

Sub SO_19105503()
    Const NameCol As Long = 1
    Const TaskCol As Long = 2
    Const DateCol As Long = 3

    Dim oShSrc As Worksheet, oShTgt As Worksheet, R As Long, C As Long
    Dim aNames As Variant, aDates As Variant
    Dim lNames As Long, lDates As Long
    Dim oRng As Range, oArea As Range

    Set oShSrc = ThisWorkbook.Worksheets("Sheet1") ' Source worksheet with original data
    oShSrc.Copy Before:=oShSrc
    Set oShSrc = ThisWorkbook.Worksheets("Sheet1 (2)") ' Copy of Source worksheet
    Set oShTgt = ThisWorkbook.Worksheets("Sheet2") ' Target worksheet to store sorted data
    oShSrc.AutoFilterMode = False
    ' Get unique names (sorted) in column A
    aNames = Array()
    lNames = 0
    R = 1
    oShSrc.UsedRange.Sort Key1:=oShSrc.Cells(R, NameCol), Header:=xlYes
    Do
        R = R + 1
        If Not IsEmpty(oShSrc.Cells(R, NameCol)) And oShSrc.Cells(R, NameCol).Value <> oShSrc.Cells(R - 1, NameCol).Value Then
            ReDim Preserve aNames(lNames)
            aNames(lNames) = oShSrc.Cells(R, NameCol).Value
            lNames = lNames + 1
        End If
    Loop Until IsEmpty(oShSrc.Cells(R, NameCol))
    ' Get unique dates (sorted) in column C
    aDates = Array()
    lDates = 0
    R = 1
    oShSrc.UsedRange.Sort Key1:=oShSrc.Cells(R, DateCol), Header:=xlYes
    Do
        R = R + 1
        If Not IsEmpty(oShSrc.Cells(R, DateCol)) And oShSrc.Cells(R, DateCol).Value <> oShSrc.Cells(R - 1, DateCol).Value Then
            ReDim Preserve aDates(lDates)
            aDates(lDates) = oShSrc.Cells(R, DateCol).Value
            lDates = lDates + 1
        End If
    Loop Until IsEmpty(oShSrc.Cells(R, DateCol))
    ' Prepare and put data to Target sheet
    oShTgt.Range("A1").Value = oShSrc.Range("A1").Value ' Name
    ' Insert Dates (start from column B on Row 1)
    For C = 0 To lDates - 1
        oShTgt.Cells(1, C + 2).Value = aDates(C)
    Next
    ' Insert Names (start from Row 2 on Column A)
    For R = 0 To lNames - 1
        oShTgt.Cells(R + 2, 1).Value = aNames(R)
    Next
    ' Reprocess the source data with Autofilter
    For R = 0 To lNames - 1
        oShSrc.AutoFilterMode = False ' Remove AutoFilter before apply
        ' Apply AutoFilter with Criteria of R'th entry in array aNames
        oShSrc.UsedRange.AutoFilter Field:=1, Criteria1:="=" & aNames(R)
        ' Go through Ranges in each Area
        For Each oArea In oShSrc.Cells.SpecialCells(xlCellTypeVisible).Areas
            For Each oRng In oArea.Rows
                ' Stop checking if row is more than used
                If oRng.Row > oShSrc.UsedRange.Rows.count Then
                    Exit For
                End If
                ' Check only if the row is below the header
                If oRng.Row > 1 Then
                    For C = 0 To lDates - 1
                        ' Find the matching date and put the "Task" value
                        If oShSrc.Cells(oRng.Row, DateCol).Value = aDates(C) Then
                            oShTgt.Cells(R + 2, C + 2).Value = oShSrc.Cells(oRng.Row, TaskCol).Value
                            Exit For
                        End If
                    Next C
                End If
            Next oRng
        Next oArea
    Next R
    Application.DisplayAlerts = False
    oShSrc.Delete ' Delete the temporary data source sheet
    Application.DisplayAlerts = True
    Set oShSrc = Nothing
    Set oShTgt = Nothing
End Sub

截图 - 源数据/结果：