Сводная таблица с двумя столбцами + максимальный третий столбец - PullRequest
0 голосов
/ 29 марта 2020

У меня есть таблица с колонками A, B и C. Значения в столбце A представляют собой список проблем, которые могут повторяться, столбец B является причиной этого указанного c вхождения, а столбец C является датой его возникновения.

Мне нужна сводная таблица, которая показывает, для каждого отдельного вопроса из столбца А - его последняя дата возникновения и причина этого последнего возникновения.

Пример:

Issue Title | Reason Description | Occurrence ------------+--------------------+-------------- Issue 1 | Reason X | Jan 1, 2020 Issue 2 | Reason Z | Jan 15, 2020 Issue 1 | Reason W | Feb 5, 2020 Issue 2 | Reason Y | Feb 20, 2020 Issue 3 | Reason X | Mar 3, 2020

Желаемая сводная таблица:

Issue Title | Reason Description | Last Occurrence ------------+--------------------+-------------- Issue 1 | Reason W | Feb 5, 2020 Issue 2 | Reason Y | Feb 20, 2020 Issue 3 | Reason X | Mar 3, 2020

Последнее вхождение для «Проблемы 1» было 5 февраля, причина W. Последнее вхождение для «Проблемы 2» было 20 февраля , причина Y, и т. д. c.

Нажмите здесь, чтобы увидеть скриншот Excel

Есть идеи, как мне этого добиться? Я знаю, что могу создать сводную таблицу со столбцом A + max (столбец C), но не знаю, как добавить столбец B, не привинчивая его.

Заранее спасибо!

1 Ответ

0 голосов
/ 01 апреля 2020

Я не могу представить себе какой-либо превосходный макрос, который бы работал; может другие могут. Вместо этого я создал короткую SQL и процедуру, которая получит желаемое.

Option Explicit
'
' needs  Tools / References / Microsoft ActiveX Data Objects v.v Library
'

Sub doSortaPivot()

    ' make sure that sheets are present and properly named
    Dim RawSheet As String, ResultSheet As String, nRow As Long
    RawSheet = "rawData"
    ResultSheet = "Result"
    Sheets(RawSheet).Select
    Sheets(ResultSheet).Select

    ' clear out the Result
    Cells.Select
    Selection.ClearContents
    nRow = 0


    '---Connecting to the Data Source---
    Dim cn As Object, rs As Object, output As String, sql As String
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ActiveWorkbook.FullName & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With

    '---Create the SQL for the Request---
    sql = "  " & _
      "  Select                                   " & _
      "      rd.[Issue Title]                     " & _
      "      ,rd.Occurrence                       " & _
      "      ,rr.[Reason Description] as Reason   " & _
      "  From (                                   " & _
      "      Select                               " & _
      "        [Issue Title]                      " & _
      "        ,max(Occurrence) as Occurrence     " & _
      "      From [Excel 12.0 Xml;IMEX=0;HDR=Yes;Database=" & ActiveWorkbook.FullName & ";Readonly=True].[rawData$]  " & _
      "      Group By [Issue Title]               " & _
      "       ) as rd                             " & _
      "  Left Join                                " & _
      "      [Excel 12.0 Xml;IMEX=0;HDR=Yes;Database=" & ActiveWorkbook.FullName & ";Readonly=True].[rawData$]  as rr  " & _
      "   On   rd.[Issue Title] = rr.[Issue Title]   " & _
      "   And  rd.[Occurrence]  = rr.[Occurrence]    " & _
      "         "

    '---Get the Data---
    Set rs = cn.Execute(sql)

    '---Put the data into the Result sheet
    Dim j As Long
    Do While Not rs.EOF

        Sheets(ResultSheet).Select
        nRow = nRow + 1
        If nRow = 1 Then    ' do the column headings
            For j = 0 To rs.Fields.Count - 1
                Cells(nRow, j + 1) = rs.Fields(j).Name
            Next j
            nRow = nRow + 1
        End If
        For j = 0 To rs.Fields.Count - 1
            Cells(nRow, j + 1) = rs.Fields(j).Value
        Next j

        rs.MoveNext
    Loop


    '---Clean up---
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing

End Sub
...