Excel VBA: Erstellen Sie ein zweidimensionales Array aus mehreren benannten Bereichen (keine Duplikate), Summenspalten

neu hier. Suchen Sie nach einer VBA-Lösung, um mehrere benannte Bereiche zusammenzuführen und Duplikate mit der Summe einiger Spalten zu entfernen. Ich habe 4 variable Bereiche: "ACTUAL", "BUDGET", "FORECAST", "PYEAR". Ich möchte diese zur Konsolidierung in einem einzigen Array kombinieren. Die Bereiche Prognose / Ist können möglicherweise Reihen von 60.000 Zeilen erreichen. Der Datenbereich für Actuals sieht folgendermaßen aus:

Lieferantennummer Ernte Gen.Gruppe Genetic Week.Comm Datum Tatsächliche Budgetprognose 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

Ich möchte die Daten auf der Grundlage der als Schlüssel aufgeführten Überschriften zusammenführen und die in den letzten 4 Spalten aufgelisteten Werte summieren: Istwert, Budget, Prognose, PJahr

Wie füge ich die separaten benannten Bereiche zusammen, die sich auf separaten Arbeitsblättern befinden, und erstelle ein Array, um 1. Duplikate durchlaufen und entfernen, 2. die erforderlichen Spalten summieren.

Jede Hilfe wird sehr geschätzt !!

Entschuldigung - Ich habe keine Ahnung, wie ich den Code richtig einfügen kann ...

Habe bisher eine Klasse und ein Modul erstellt, es handelt sich aber nur um einen Bereich. Ich weiß immer noch nicht, wie ich die Bereiche zu einem zusammenfügen soll, bevor ich den folgenden Code durchsehe:

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 

Unten ist der Modulcode:

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