मिलान आईडी के आधार पर जानकारी कॉपी और पेस्ट करें जहां पिटोट टेबल

Question

में एक शीट की पंक्तियां हैं मेरे पास एक कोड है जो मुझे मिलान आईडी के आधार पर जानकारी की हजारों पंक्तियों की प्रतिलिपि बनाने और चिपकाने की अनुमति देता है। हालांकि कोड एक पिवट तालिका में अच्छी तरह से चलाने के लिए प्रतीत नहीं होता है। शीट 4 में, आईडी को पिवट तालिका में रखा जाता है जबकि शीट 1 आईडी में और जानकारी पिवट तालिका में नहीं होती है (शीट 4 और 1 में दोनों आईडी कॉलम ए के समान कॉलम में होती हैं)। हालांकि, आईडी 1 शीट में एक से अधिक बार दिखाई दीं। इस प्रकार, जब मैं कोड चलाने की कोशिश करता हूं, तो उसने एक त्रुटि दी जो Cannot enter a null value as an item or field name in pivot table report" on the line 'rngTracker.Value = arrT नीचे पाया गया।

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 में पिवट टेबल की छवि है। "एसी सेग" नामक कॉलम हेडर पिवट टेबल का हिस्सा नहीं है, लेकिन यह वह जगह है जहां डेटा शीट 1 से पेस्ट किया जाएगा जब शीट 4 और शीट 1 में दोनों आईडी मिलान नहीं हुआ।

Answer 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