Excel VBA-使用3个行元素和1个列元素从数据透视表获取数据 [英] Excel VBA - Get data from Pivot Table using 3 row elements and 1 column element

问题描述

我有一个数据透视表，其中包含11000多个数据行和53列.我需要一段代码，可以非常有效地从数据透视表中的特定单元格中获取数据.

I have a Pivot Table with more than 11,000 rows of data and 53 columns. I need a piece of code that very efficiently fetches data from a particular cell in the Pivot Table.

数据透视表的外观如下:

This is what the Pivot Table looks like:

我需要能够使用左侧的三(3)列从特定单元格中获取数据，这是选择正确的行并通过使用顶部的第1-50周偏移到正确的列的条件.

I need to be able to fetch data from particular cells using the three (3) columns to the left as the conditions from picking the correct row and offset to the correct column by using the week numbers 1-50 at the top.

这是我当前代码的一小段内容(可以正常工作，但是效率很低，因为我现在需要大约48次查询.

Here's a snippet of my current code (which works, but is probably highly inefficient since I need to this query about 48 times right now.

Dim oWB As Workbook: Set oWB = Workbooks.Open(tWB.Path & "\Telledata egeneide YTD.xlsx", ReadOnly:=True)
Dim oWS As Worksheet: Set oWS = oWB.Sheets("Telledata")
Dim pivotdata As Integer
Dim storeNo As Integer = 1101 'Example only - this can be anything between 1101 and 1199
Dim storeLoc As String = "0002" 'Example only - this value can be anything between 0001 and 0003
Dim materialGroup As Integer = 1120 'Example only - this can be anything between 1110 and 1899
Dim week as Integer = 11 'Example only - this can be anything between 1 and 50

pivotdata = Application.WorksheetFunction.CountIfs(oWS.Range("A:A"), storeNo, _
                                    oWS.Range("B:B"), storeLoc, _
                                    oWS.Range("C:C"), materialGroup, _
                                    oWS.Range("C:C").Offset(0, week), ">4")

我正在寻找大于4的值.如上所述，随着代码段中变量的变化，最后的查询需要运行至当前状态的48倍.

I'm looking for values that are higher than 4. As mentioned, the query at the end needs to be run up to 48 times as it currently stands, as the variables in the code snippet changes.

示例查询:

storeNo: 1101
storeLoc: 0001
materialGroup: 1141, 1142, 1143, 1410, 1420, 1451, 1220, 1260, 1270, 1710, 1720, 1730
week: 11, 12

storeNo: 1101
storeLoc: 0002
materialGroup: 1141, 1142, 1143, 1410, 1420, 1451, 1220, 1260, 1270, 1710, 1720, 1730
week: 11, 12

如您所见，所有查询都必须运行两次(对于每个storeLoc)，再加上我必须检查两个WEEK列(选定的星期和之后的星期).

As you can see, all the queries have to be run twice (for each storeLoc), plus I have to check two WEEK columns (the chosen week and the week after).

我一直在考虑一个For/For Each循环，但不确定如何实现...

I've been thinking about a For / For Each loop, but not sure how to go about that...

推荐答案

这是一种使用字典查询的方法，该方法基于3个查询列的唯一组合:

Here's one approach using a dictionary lookup based on the unique combinations of the 3 lookup columns:

(未经测试)

Sub Tester()
    
    Dim pt As PivotTable, rngRows As Range, rngData As Range
    Dim dict As Object, arrRows, arrData, r As Long, k
    
    Set pt = ActiveSheet.PivotTables(1)
    
    'https://peltiertech.com/referencing-pivot-table-ranges-in-vba/
    Set rngRows = pt.RowRange   'get the rows range (includes headers)
    Set rngRows = rngRows.Offset(1, 0).Resize(rngRows.Rows.Count - 1) 'exclude headers
    arrRows = rngRows.Value     '... get as 2D array
    
    'create lookup based on the 3 columns
    Set dict = CreateObject("scripting.dictionary")
    For r = 1 To UBound(arrRows, 1)
        k = Key(arrRows(r, 1), arrRows(r, 2), arrRows(r, 3))
        dict(k) = r 'link the key to the row number
    Next r
    
    Set rngData = pt.DataBodyRange    'the data from the table
    arrData = rngData.Value           '... as 2D array
    
    
    'now you can use the lookup to quickly locate the data you want
    k = Key(storeNo, storeLoc, materialGroup)
    If dict.exists(k) Then
        weekVal = arrData(dict(k), WeekNum)
        If weekNum < UBound(arrData, 2) Then 
            nextWeekVal = arrData(dict(k), WeekNum + 1)
        End If
    Else
        'no match found
    End If
    
End Sub

'create key by concatenating the values with "|"
Function Key(v1, v2, v3)
    Key = Join(Array(v1, v2, v3), "|")
End Function

这篇关于Excel VBA-使用3个行元素和1个列元素从数据透视表获取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！