VBA: Range in Array laden, SVerweis, auslesen

[Ralf A]

@Flotter Feger,

Die spielt nicht ... die will nur beissen ...

...laut lach! Seit wann denn das? Hast Du Dich irgendwo angesteckt?

Hi Sludy,

weshalb solch unnötigen Klimmzüge via VBA? Oder vorhandene Daten nochmal in ein Array, Dictionary oder sonstwas laden? Und 2 Stunden für die Berechnung? Wow... in welche Galaxy schickst Du die Daten?

Mach eine intelligente Tabelle aus Deinem Datenbereich. Dann kannst Du eine Ergebniszeile hinzufügen oder in einer Zelle deiner Wahl folgende Funktion einfügen:
=TEILERGEBNIS(9;tblDaten[[#Daten];[Menge]])

Voraussetzung,tblDaten ist der Name der intelligenten Tabelle. Dann kannst Du Dir auch den Button sparen und erhältst in Nullkommanix das gefilterte Ergebnis. Optional kannst Du auch Slicer einsetzen.
Weiterer Vorteil, Du musst Dich nicht um die Erweiterung der Tabellenbereiche kümmern..
Sh. Anhang Blatt AlternativTest

[DerHoepp]

Moinsen,

noch viel einfacher ist eine Pivottabelle.

Viele Grüße
derHöpp

[Sludy]

Hallo Daniel,

du sagtest, dass das letzte Vorkommen des Materials in der Ausgangstabelle ausgegeben wird. Wie müsste man den Code umändern, damit nicht das letzte sondern stets das erste Vorkommen ausgegeben wird?

HI
sammle die Daten in einem zweiten Dictinary und spiele sie dann für die Ausgabe dazu:

Code: Alles auswählen

Sub Summe()

Dim t As Double

 t = Timer


Dim dict As Object
Dim arr As Variant, arr2 As Variant
Dim L As Long
arr = Sheets("Test").Range("A7:E20").Value

Set dict = CreateObject("scripting.dictionary")
Set dict2 = CreateObject("scripting.dictionary")
'Berechnen
For L = 1 To UBound(arr)
    dict(arr(L, 1)) = dict(arr(L, 1)) + arr(L, 2)
    dict2(arr(L, 1)) = Array(arr(L, 3), arr(L, 4), arr(L, 5))
Next

'Ausgabe
With Sheets("Auswertung").Range("B3:F9")
    arr2 = .Value
    For L = 1 To UBound(arr2)
        If dict.exists(arr2(L, 1)) Then
            arr2(L, 2) = dict2(arr2(L, 1))(0)
            arr2(L, 3) = dict(arr2(L, 1))
            arr2(L, 4) = dict2(arr2(L, 1))(1)
            arr2(L, 5) = dict2(arr2(L, 1))(2)
        End If
    Next
    .Value = arr2
End With



MsgBox Timer - t & " sec", , "Makrolaufzeit"

End Sub

ich gehe mal davon aus, dass die Zusätzlichen Daten für jedes Material gleich sind.
sollten sie es nicht sein, so wird der zustand des letzten Vorkommens des Materials in der Ausgangstabelle verwendet

Gruß Daniel

VG Sludy

[Sludy]

Hallo zusammen,

habe die Lösung selbst gefunden:

Code: Alles auswählen

For L = 1 To UBound(arr1)

        If L = 1 Then
       
            dict1(arr1(L, 1)) = Array(arr1(L, 2), arr1(L, 3), arr1(L, 4))
       
        Else
       
            If arr1(L, 1) <> arr1(L - 1, 1) Then
           
            dict1(arr1(L, 1)) = Array(arr1(L, 2), arr1(L, 3), arr1(L, 4))
       
            End If
       
        End If
     
    Next

Gruß Sludy