使用 1 行元素和 2 列元素从数据透视表中提取“零”数据作为“名称 + 日期”

Question

我搜索过，但没有发现任何有趣的东西。我加入了 ChatGPT。

• 在“OB”表中，我有一个名为“OBEC_ALL”的数据透视表。
• 在此表的列中，我有以下数据：“date”和“prc？”，其中的日期是我的，例如“2023.12.06”和“prc？”我有“T”或“N”（是/否）
• 在这些行中我有“代码”数据，例如101、203、305 等以及“雇员”，例如“约翰·多伊”。
• 数据透视表的结果包括显示某个人在给定日期发生的事件（“事件”）数量的数字。如果没有事件，则插入零“0”（在表设置中，在空字段中插入零）。

我愿意：

• 在“OB”工作簿之后创建一个新工作表“test”
• 如果值字段为零，则在此表的下一行中写入“规则”，同时在此列中写入“prc？”值为“T”
• 这条规则例如Emily Johnson - 2023 年 12 月 04 日及以下是另一个不同日期的日期，其值为 0 且“prc？”有一个“T”

本质就是将某一天数据库中没有事件的“员工+日期”对逐行写出来，以便能够报告和完成。

Sub WypiszZeroweZdarzenia()
    Dim wsOB As Worksheet
    Dim wsTest As Worksheet
    Dim pivotTable As PivotTable
    Dim dataRange As Range
    Dim cell As Range
    Dim pracownik As String
    Dim data As Date
    Dim isZero As Boolean
    Dim prcValue As Variant
    
    ' Ustaw arkusz "OB" jako aktywny
    Set wsOB = Sheets("OB")
    wsOB.Activate
    
    ' Ustaw pivot table
    Set pivotTable = wsOB.PivotTables("OBEC_ALL")
    
    ' Ustaw zakres danych dla pola "Zdarz"
    Set dataRange = pivotTable.DataBodyRange
    
    ' Sprawdź, czy arkusz "test" już istnieje
    On Error Resume Next
    Set wsTest = Worksheets("test")
    On Error GoTo 0
    
    ' Jeżeli arkusz "test" nie istnieje, utwórz nowy zaraz za arkuszem "OB"
    If wsTest Is Nothing Then
        Set wsTest = Sheets.Add(After:=wsOB)
        wsTest.Name = "test"
    Else
        ' Jeżeli istnieje, wyczyść zawartość od komórki A1 w dół
        wsTest.Cells.Clear
    End If
    
    ' Dla każdej komórki w zakresie danych
    For Each cell In dataRange
        ' Sprawdź, czy wartość w komórce to 0
        If cell.Value = 0 Then
            ' Pobierz pracownika i datę
            pracownik = cell.RowFields(2).Name
            data = cell.ColumnFields(1).Name
            
            ' Sprawdź wartość "prc?" dla danej daty
            prcValue = cell.ColumnFields(2).Name
            
            ' Ustaw flagę na true tylko jeżeli "prc?" to "T"
            isZero = (prcValue = "T")
            
            ' Sprawdź kolejne komórki w wierszu, aby uniknąć powtórzeń dla tego samego pracownika
            For Each cellInRow In cell.RowRange
                If cellInRow.Value = 0 Then
                    ' Jeżeli kolejna komórka w wierszu również ma wartość 0, to ustaw flagę na false
                    isZero = False
                    Exit For
                End If
            Next cellInRow
            
            ' Jeżeli flaga jest nadal true, to wpisz dane do arkusza "test"
            If isZero Then
                wsTest.Cells(wsTest.Cells(wsTest.Rows.Count, "A").End(xlUp).Row + 1, 1).Value = pracownik & " - " & Format(data, "yyyy.mm.dd")
            End If
        End If
    Next cell
End Sub

出现错误 438。

调试显示：

pracownik = cell.RowFields(2).Name

Answer 1

• GPT 使代码变得比应有的更复杂。
• 将数据透视表加载到数组中，然后提取数据
• 一次性将输出写入工作表

Option Explicit

Sub Demo()
    Dim i As Long, j As Long
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long
    Dim LastRow As Long, wsOB As Worksheet
    Set wsOB = Sheets("OB")
    Set rngData = wsOB.PivotTables("OBEC_ALL").TableRange1
'    Set rngData = wsOB.Range("B4:AH12") ' for testing
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData) * 31, 0)
    iR = 0
    For j = LBound(arrData, 2) + 2 To UBound(arrData, 2)
        If arrData(4, j) = "T" Then
            For i = LBound(arrData) + 4 To UBound(arrData)
                If arrData(i, j) = 0 Then
                    iR = iR + 1
                    arrRes(iR, 0) = arrData(i, 2) & " - " & Format(arrData(2, j), "yyyy.mm.dd")
                End If
            Next
        End If
    Next
    Sheets.Add
    Range("A1:A" & iR).Value = arrRes
End Sub

输出表中的前十个单元格

Emily Johnson - 2023.12.04
Emily Johnson - 2023.12.05
Emily Johnson - 2023.12.06
Michael Davis - 2023.12.06
Emily Johnson - 2023.12.07
Michael Davis - 2023.12.07
Emily Johnson - 2023.12.08
Michael Davis - 2023.12.08
Emily Johnson - 2023.12.11
Michael Davis - 2023.12.11

请先在数据透视表上应用

Repeat All Item Lable

。

那么就很容易得到

kod

。

arrRes(iR, 0) = arrData(i, 1) & " - " & arrData(i, 2) & " - " & Format(arrData(2, j), "yyyy.mm.dd")