根据数据透视表中一个表中具有行的匹配ID复制和粘贴信息

我有一个代码,允许我根据匹配的ID复制和粘贴数千行信息。 但是,代码在数据透视表中似乎不能很好地运行。 在工作表4中,将ID放入数据透视表中,而在工作表1中,ID和信息不在数据透视表中(工作表4和1中的两个ID在列A中的同一列中)。 但是,ID在工作表1中出现了不止一次。因此,当我尝试运行代码,它给了一个错误,说Cannot enter a null value as an item or field name in pivot table report" on the line 'rngTracker.Value = arrT在下面find。

 Sub Sample() Dim rngTracker As Range Dim rngMaster As Range Dim arrT, arrM Dim dict As Object, r As Long, tmp With Workbooks("FAST_Aug2015_Segment_Out_V1.xlsm") Set rngTracker = .Sheets("Sheet4").Range("A5:D43000") Set rngMaster = .Sheets("Sheet1").Range("A2:C200000") End With 'get values in arrays arrT = rngTracker.Value arrM = rngMaster.Value 'load the dictionary Set dict = CreateObject("scripting.dictionary") For r = 1 To UBound(arrT, 1) dict(arrT(r, 1)) = r Next r 'map between the two arrays using the dictionary For r = 1 To UBound(arrM, 1) tmp = arrM(r, 1) If dict.exists(tmp) Then arrT(dict(tmp), 4) = arrM(r, 3) End If Next r rngTracker.Value = arrT 'Error shown on this line' End Sub 

以上是我的代码,并给出了上述错误。 将不胜感激任何帮助。 谢谢。 :)下面是工作表4中数据透视表的图像。名为“Acc Seg”的列标题不是数据透视表的一部分,但是当数据表4和数据表1中的两个ID都是从数据表1粘贴数据的位置匹配。 在这里输入图像说明

 Option Explicit Public Sub Sample() Const T As Long = 43000 Const M As Long = 200000 Dim arrT1 As Variant, arrM1 As Variant, rngT2 As Range Dim arrT2 As Variant, arrM2 As Variant, dict As Object, r As Long With Workbooks("TEST2.xlsm") 'get values in arrays Set rngT2 = .Sheets("Sheet4").Range("D5:D" & T) arrM1 = .Sheets("Sheet1").Range("A2:A" & M) arrM2 = .Sheets("Sheet1").Range("C2:C" & M) arrT1 = .Sheets("Sheet4").Range("A5:A" & T) arrT2 = rngT2 End With Set dict = CreateObject("Scripting.Dictionary") For r = 1 To UBound(arrT1) 'load the dictionary dict(arrT1(r, 1)) = r Next r For r = 1 To UBound(arrM1, 1) 'map between the arrays using the dictionary If dict.exists(arrM1(r, 1)) Then arrT2(dict(arrM1(r, 1)), 1) = arrM2(r, 1) Next r rngT2 = arrT2 End Sub