excel - 查找数据时返回文本

Question

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

名称 任务日期
迈克去海滩 10/1/13
迈克去购物 10/2/13
迈克 2013 年 10 月 3 日去上班
比尔去远足 10/1/13
比尔去上班 10/3/13

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

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

结果应如下所示：

名称 10/1/13 10/2/13 10/3/13
迈克 去海滩 去购物 去工作
比尔去远足 *空白*去上班

我试图发布图片但不能因为这是我的第一篇文章。我希望你能明白我在问什么。

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

屏幕截图 - 源数据/结果：