Gamme Nielsen Nitro (gamme Blueberry) refresh

Question

Je suis à la recherche de VBA pour rafraîchir la gamme Nielsen Nitro.

Nielsen Nitro est une application pour extraire des données de la base de données. gamme aussi est appelée gamme Blueberry pour actualiser les données

J'ai essayé d'utiliser VBA ci-dessous, mais il ne fonctionnait pas

Dim acnNitro As New ACNNITRO 
Dim acnNitroUpdate As ACNielsenNitro.ACNNitroUpdate 
Dim WS As Worksheet 
Dim bret as Boolean 
acnNitro.ParentApp = Application 
acnNitroUpdate = acnNitro.ACNNitroUpdate 
WS = ActiveSheet 'or Set WS = WorkSheets("My Sheet") 
bret = acnNitroUpdate.UpdateAllNRanges(WS, ntrSelectGet) 
acnNitro = Nothing 
acnNitroUpdate = Nothing 
WB = Nothing 

screenshot

J'ai également fourni capture d'écran pour la gamme.

Pouvez-vous s'il vous plaît me suggérer pour le code VBA?

Answer 1

J'ai écrit un code similaire pour un projet, trouvez le code ci-dessous. Cela pourrait vous aider!

Public Sub NeilsenRefresh() 
 

 
Dim str_RngDesc As Variant 
 
Dim bRet As Boolean 
 

 
Dim RngObj As NITRORange 
 
Dim acnNITROUpdt As Object 
 
Dim acnNITRO As Object 
 
Dim NRangeObj As NITRORange 
 
Dim cRange As Object 
 
Dim Bubble As String 
 
Set acnNITRO = CreateObject("ACNielsenNitro.ACNNitro") 
 
Set acnNITRO.ParentApp = ActiveWorkbook.Application 
 
Set acnNITROUpdt = acnNITRO.ACNNitroUpdate 
 
Application.ScreenUpdating = False 
 
Application.DisplayAlerts = False 
 
Application.Calculation = xlCalculationManual 
 

 

 
With ThisWorkbook.Sheets("Macro") 
 

 
WkbName = .Range("G9").Value 
 
Path = .Range("G12").Value 
 
Bubble = .Range("G15").Value 
 
Atribute = .Range("G18").Value 
 
WkList = .Range("G6").Value 
 

 
End With 
 

 
'Sheets("Data").Activate 
 

 
With ThisWorkbook.Sheets("Data") 
 

 
    lr = .Range("A1048576").End(xlUp).Row 
 

 
    If lr > 1 Then 
 
    
 
    .Range("Q1:Q" & lr).ClearContents 
 
    .Range("A2:A" & lr).ClearContents 
 
    .Range("B3:C" & lr).ClearContents 
 
    .Range("D2:D" & lr).ClearContents 
 
    .Range("R2:R" & lr).ClearContents 
 
    .Range("S2:S" & lr).ClearContents 
 
    
 
End If 
 
    
 
Set WkbList = Workbooks.Open(Path & "\" & WkList & ".xlsx") 
 
Set wks = WkbList.Sheets("Sheet1") 
 
lrw = wks.Range("A1048576").End(xlUp).Row 
 
wks.Range("A2:A" & lrw).Copy 
 
.Range("A2").PasteSpecial Paste:=xlPasteValues 
 
wks.Range("B2:B" & lrw).Copy 
 
.Range("D2").PasteSpecial Paste:=xlPasteValues 
 
    
 
lr = .Range("A1048576").End(xlUp).Row 
 

 
.Range("B2:C" & lr).FillDown 
 
.Calculate 
 
    
 
Set wksmiss = ThisWorkbook.Sheets("Missing Records") 
 

 
lrw = wksmiss.Range("A1048576").End(xlUp).Row 
 
If lrw > 1 Then wksmiss.Range("A2:B" & lrw).ClearContents 
 

 
    
 
.Range("A1:D" & lr).AutoFilter Field:=2, Criteria1:="#N/A" 
 

 
lrw = .Range("A1048576").End(xlUp).Row 
 

 
If lrw > 1 Then 
 

 
    .Range("B2:B" & lrw).SpecialCells(xlCellTypeVisible).Copy 
 
    wksmiss.Range("A2").PasteSpecial Paste:=xlPasteValues 
 
    .Range("D2:D" & lrw).SpecialCells(xlCellTypeVisible).Copy 
 
    wksmiss.Range("B2").PasteSpecial Paste:=xlPasteValues 
 
    .Range("A2:D" & lrw).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp 
 
    
 
End If 
 

 
.Range("A1:D" & lr).AutoFilter 
 
.Range("B2:C" & lr).FillDown 
 
.Calculate 
 

 
    
 
.Calculate 
 
.Range("A2:A" & lr).Copy 
 
.Range("Q1").PasteSpecial Paste:=xlPasteValues 
 
.Range("Q1:Q" & lr).RemoveDuplicates Columns:=1, Header:=xlNo 
 

 
    lrd = .Range("Q1048576").End(xlUp).Row 
 
.Range("R1:R" & lrd).FillDown 
 
.Range("S1:S" & lrd).FillDown 
 
.Range("A1").Value = "Cum Name" 
 
.Calculate 
 

 
    For i = 1 To lrd 
 
    
 
    CumName = .Range("Q" & i).Value 
 
    Cnt = .Range("R" & i).Value 
 
    FstIndex = .Range("S" & i).Value 
 
    
 
    RowNo = FstIndex + Cnt - 1 
 
    val1 = .Range("C" & RowNo).Value 
 
    
 
    If CumConcat = "" Then 
 
    
 
    CumConcat = val1 & "," 
 
     
 
    Else 
 
    
 
    val1 = Replace(val1, "MKT", "") 
 
    CumConcat = CumConcat & val1 & "," 
 
     
 
    End If 
 
    
 
    
 
    Next 
 

 

 
End With 
 

 

 
Set wkb = Workbooks.Open(Path & "\" & WkbName & ".xlsx") 
 

 
Set RngObj = acnNITRO.ACNRangeUtility.GetNRange(Bubble, ActiveWorkbook) 
 
RngObj.DimCount = 4 
 
RngObj.DimIndex = Atribute 
 
RngObj.DimGetString = CumConcat 
 

 
str_RngDesc = RngObj.RangeDescription 
 
Set acnNITROUpdt = acnNITRO.ACNNitroUpdate 
 

 
bRet = acnNITROUpdt.UpdateNRange(ActiveWorkbook, Bubble, 0) 
 

 
WkbList.Close 
 
Application.ScreenUpdating = True 
 
Application.DisplayAlerts = True 
 
Application.Calculation = xlCalculationAutomatic 
 

 
ThisWorkbook.Sheets("Macro").Activate 
 
MsgBox "Nielsen Refresh Completed", vbInformation 
 

 
End Sub