Excel VBA: создать двумерный массив из нескольких именованных диапазонов (без дубликатов), столбцов суммы

Question

новенький тут. ищу решение VBA для объединения нескольких именованных диапазонов и удаления дубликатов с суммой в некоторых столбцах. У меня есть 4 диапазона переменных: "ACTUAL", "BUDGET", "FORECAST", "PYEAR". Я хотел бы объединить их в один массив для консолидации. Диапазоны Прогноз / Факт могут потенциально достигать 60К строк. Диапазон данных для Actuals выглядит следующим образом:

Vendor # Crop Gen.Group Genetic Week.Дата приезда Фактический бюджетный прогноз PYear

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

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

12345 STRA CSTA XXXXXX 22.08.16 22.08.16 3500

Я хочу объединить данные на основе заголовков, указанных в качестве ключа, суммируя значения, перечисленные в последних 4 столбцах: факт, бюджет, прогноз, год

Как объединить отдельные именованные диапазоны, которые находятся на отдельных листах, и создать массив для 1. циклического прохождения и удаления дубликатов, 2. суммирования необходимых столбцов.

Любая помощь с благодарностью!

Извинения - я понятия не имею, как правильно добавить код в ...

До сих пор создали класс и модуль, но он имеет дело только с одним диапазоном. Я до сих пор не знаю, как объединить диапазоны в один, прежде чем проходить через код ниже:

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

ниже приведен код модуля:

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

Если вам действительно не нужно объединять именованные диапазоны в один диапазон перед обработкой, просто обрабатывайте их по одному за раз. Вот один из подходов:

---

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

---

Вместо этого вы могли бы также использовать цикл For Each ... , но с таким небольшим массивом, я сомневаюсь, вы увидите какую-либо разницу