Excel VBA: cria uma matriz bidimensional a partir de vários intervalos nomeados (sem duplicatas), soma colunas

Question

novo aqui. procurando por uma solução VBA para mesclar vários intervalos nomeados e remover duplicatas com soma em algumas colunas. Eu tenho 4 intervalos variáveis: "ACTUAL", "ORÇAMENTO", "PREVISÃO", "PYEAR" Eu gostaria de combiná-los em um único array para consolidação. Os intervalos de previsão / real podem atingir 60 mil linhas. O intervalo de dados para os dados reais se parece com:

Fornecedor # Crop Gen.Group Genetic Week.Comm Data Previsão do Orçamento Real PYear

12345 STRA CSTA AMESTI 22/08/16 22/08/16 3.500

12345 STRA CSTA AMESTI 22/08/16 23/08/16 3.500

12345 STRA CSTA XXXXXX 22/08/16 22/08/16 3.500

Eu quero mesclar os dados com base nos títulos listados como Chave, somando os valores listados nas últimas 4 colunas: Real, Orçamento, Previsão, PYear

Como faço para mesclar os intervalos nomeados separados que estão em planilhas separadas e criar uma matriz para 1. percorrer e remover duplicatas, 2. somar as colunas necessárias.

Qualquer ajuda é muito apreciada !!

Desculpas - não tenho ideia de como adicionar o código corretamente ...

Até agora, criou uma classe e um módulo, mas trata apenas de um intervalo. Ainda não sei como mesclar os intervalos em um antes de passar pelo código abaixo:

Option Explicit
Private pID As String
Private pVendor As String
Private pCrop As String
Private pGenGrp As String
Private pGenetic As String
Private pWcomm As Date
Private pDate As Date
Private pAct As Double
Private pBud As Double
Private pPyr As Double
Private pFct As Double

Public Property Get MergeKey() As String
MergeKey = pID
End Property 
Public Property Let MergeKey(value As String)
pID = value
End Property
Public Property Get Vendor() As String
Vendor = pVendor
End Property
Public Property Let Vendor(value As String)
pVendor = value
End Property
Public Property Get Genetic() As String
Genetic = pGenetic
End Property
Public Property Let Genetic(value As String)
pGenetic = value
End Property
Public Property Get GrDate() As Date
GrDate = pDate
End Property
Public Property Let GrDate(value As Date)
pDate = value
End Property
Public Property Get WeekComm() As Date
WeekComm = pWcomm
End Property
Public Property Let WeekComm(value As Date)
pWcomm = value
End Property
Public Property Get Crop() As String
Crop = pCrop
End Property
Public Property Let Crop(value As String)
pCrop = value
End Property
Public Property Get Actual() As Double
Actual = pAct
End Property
Public Property Let Actual(value As Double)
pAct = value
End Property
Public Property Get Budget() As Double
Budget = pBud
End Property
Public Property Let Budget(value As Double)
pBud = value
End Property
Public Property Get Forecast() As Double
Forecast = pFct
End Property
Public Property Let Forecast(value As Double)
pFct = value
End Property
Public Property Get GeneticGroup() As String
GeneticGroup = pGenGrp
End Property
Public Property Let GeneticGroup(value As String)
pGenGrp = value
End Property

abaixo é o código do módulo:

Sub DailyVolumes()
Dim eSrc As Range  
Dim wseSrc As Worksheet

Dim vSrc As Variant
Dim cV As cItems, colDaily As Collection
Dim vVarRanges As Variant
Dim vRes() As Variant, rRes As Range

Dim vResults() As Variant
Dim sKey As String
Dim i As Long, J As Long, K As Long

Set wseSrc = Worksheets("CONSOL")
Set eSrc = wseSrc.Range("G1:P1")
Set rRes = wseSrc.Range("G1")
'Read Named ranges to array
vVarRanges = Range("ACTUALS")
vSrc = vVarRanges

'Collect the Daily volumes into a Collection keyed to Merge ID
 Set colDaily = New Collection
 On Error Resume Next
 For i = 2 To UBound(vSrc, 1)
  Set cV = New cItems
  With cV
        .MergeKey = vSrc(i, 1)
        .Vendor = vSrc(i, 2)
        .Genetic = vSrc(i, 3)
        .GrDate = vSrc(i, 4)
        .WeekComm = vSrc(i, 5)
        .GeneticGroup = vSrc(i, 6)
        .Crop = vSrc(i, 7)
        .Actual = vSrc(i, 8)
        .Forecast = vSrc(i, 9)
        .Budget = vSrc(i, 10)
        sKey = CStr(.MergeKey)
        colDaily.Add cV, sKey
'If the record for this Merge ID already exists, then add the values to the existing record
  If Err.Number = 457 Then
        With colDaily(sKey)
              .Actual = .Actual + cV.Actual
              .Forecast = .Forecast + cV.Forecast
              .Budget = .Budget + cV.Budget
        End With
  ElseIf Err.Number <> 0 Then MsgBox (Err.Number)
  End If
  Err.Clear
  End With
Next i
On Error GoTo 0


'To minimise chance of out of memory errors with large data
'Erase vSrc
'vSrc = eSrc.Rows(1)

'Write the collection to a "Results" array, then write it to the worksheet and format
ReDim vRes(0 To colDaily.Count + 1, 1 To 10)
  For i = 1 To UBound(vRes, 2)
        vRes(0, i) = vSrc(1, i)
  Next i
  For i = 1 To colDaily.Count
        With colDaily(i)
        vRes(i, 1) = .MergeKey
        vRes(i, 2) = .Vendor
        vRes(i, 3) = .Genetic
        vRes(i, 4) = .GrDate
        vRes(i, 5) = .WeekComm
        vRes(i, 6) = .GeneticGroup
        vRes(i, 7) = .Crop
        vRes(i, 8) = .Actual
        vRes(i, 9) = .Forecast
        vRes(i, 10) = .Budget
        End With
  Next i

  With rRes.Resize(UBound(vRes), UBound(vRes, 2))
        .EntireColumn.Clear
        .value = vRes
  End With
  End Sub

    

Answer 1

Se você realmente não precisa mesclar os intervalos nomeados em um único intervalo antes do processamento, basta processá-los um de cada vez. Aqui está uma abordagem:

Dim arrRanges As Variant, rngCntr As Long
arrRanges = Array("ACTUAL","BUDGET","FORECAST","PYEAR")

'Collect the Daily volumes into a Collection keyed to Merge ID
 Set colDaily = New Collection

 For rngCntr = 0 To UBound(arrRanges)
 vSrc = arrRanges(rngCntr)

 On Error Resume Next
 For I = 2 To UBound(vSrc, 1)
  Set cV = New cItems
  ...
  ...
Next I
On Error GoTo 0

Next rngCntr

Você também pode usar um loop For Each ... , mas com uma matriz tão pequena, duvido que você veja alguma diferença.