0

次のようなスプレッドシートがあります。

名前 タスクの日付
マイク ビーチに行く 10/1/13
マイク ゴー ショッピング 10/2/13
マイク 仕事に行く 10/3/13
ビル ゴー ハイキング 10/1/13
ビル 仕事に行く 10/3/13

データタブを見て、行と列が一致すると一致するテキスト値を返すスプレッドシートに別のタブを作成しようとしています。

式を使用してピボット テーブルのタイプを作成しようとしています。

結果は次のようになります。

名前 10/1/13 10/2/13 10/3/13
マイク ビーチに行く 買い物に行く 仕事に行く
Bill Go ハイキング *空白* 仕事に行く

画像を載せようとしたのですが、初投稿なので出来ませんでした。私が求めていることを理解していただければ幸いです。

4

1 に答える 1

0

私はピボット テーブルの専門家ではありません。仮定:

1) ソース データは常に「Sheet1」にあり、これらの 3 つの列ヘッダーがあります

2) 「シート 2」は、並べ替えられたデータを格納するために使用されます

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

スクリーンショット - ソース データ/結果:

ソースデータ ここに画像の説明を入力

于 2013-10-02T04:05:50.357 に答える