VBA: Range in Array laden, SVerweis, auslesen

Moderator: ModerationP

VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Sludy » 13. Jun 2019, 20:30

Hallo zusammen,

ich habe mal wieder ein neues Vorhaben bzw. will ein vorhandenes gern erweitern. Im nachfolgendem Beitrag wurde mir bereits sehr gut geholfen, um einen Range in den Arbeitsspeicher zu laden, dort eine Berechnung durchzuführen und deren Ergebnis im Anschluss wieder in Excel auszulesen:

http://www.office-loesung.de/p/viewtopic.php?f=166&t=805740&start=15

Code: Alles auswählen
Sub Summe1()

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

Set dict = CreateObject("scripting.dictionary")
'Berechnen
For L = 1 To UBound(arr)
    dict(arr(L, 1)) = dict(arr(L, 1)) + arr(L, 2)
Next
arr2 = Sheets("Auswertung").Range("B3:B9").Value
For L = 1 To UBound(arr2)
    arr2(L, 1) = dict(arr2(L, 1))
Next

'Ausgabe

Sheets("Auswertung").Range("D3").Resize(UBound(arr2)).Value = arr2

End Sub

Die dort benutzte Beispiel Excel Datei habe ich nun erneut modifiziert und dem Beitrag mit angehängt. Durch welche Zeilen müsste ich den vorhandenen Code erweitern/anpassen, um die fehlenden Spalten im Reiter "Auswertung" per Sverweis füllen, ohne dabei die "vlookup" Funktion zu verwenden?

Beste Grüße
Sludy
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 97
Registriert: 22. Jul 2016, 11:49

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Sludy » 14. Jun 2019, 19:30

Hallo zusammen,

ist die geplante Ergänzung für den vorhandenen Code zu aufwendig oder müsste dadurch sogar ggfs. ein komplett neuer Code geschrieben werden?

VG Sludy
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 97
Registriert: 22. Jul 2016, 11:49

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Flotter Feger » 14. Jun 2019, 20:29

Hallo,

etwas nachzubauen, was Excel eigentlich schon kann ... und zwar bestens ... erscheint mir nicht sehr sinnvoll ... den anderen scheinbar auch nicht.
VG Sabina

bei mir läuft Win 7 32-Bit - Office 2010 Pro Plus 32-Bit und Office 2016 Pro Plus 32-Bit
Wer auch weiter Hilfe erwartet, sollte sich nicht zu schade sein, ein kurzes Feedback zu geben.
Benutzeravatar
Flotter Feger
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2171
Registriert: 24. Okt 2016, 16:40

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Sludy » 14. Jun 2019, 20:42

Hi Flotter Feger,

naja bei einer großen Datensammlung kann das Excel eben nicht am besten. Meine eine Datei hat 2 Stunden gebraucht durch die Vielzahl an den darin enthaltenden SVerweisen. Aus dieser Sicht her empfinde ich das schon als wichtiges / sinnvolles Thema.

VG Sludy
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 97
Registriert: 22. Jul 2016, 11:49

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon HSV » 14. Jun 2019, 22:38

Z.B.

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
Dim a, b(4)
arr = Sheets("Test").Range("A7:E20").Value

Set dict = CreateObject("scripting.dictionary")
'Berechnen
For L = 1 To UBound(arr)
 a = dict(arr(L, 1))
   If IsEmpty(a) Then a = b
    a(0) = arr(L, 1)
    a(1) = a(1) + arr(L, 2)
    a(2) = arr(L, 3)
    a(3) = arr(L, 4)
    a(4) = arr(L, 5)
  dict(arr(L, 1)) = a
Next


'Ausgabe

Sheets("Auswertung").Range("B3").Resize(dict.Count, 5) = Application.Index(dict.items, 0, 0)



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

End Sub
Gruß, Harry.
Benutzeravatar
HSV
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 213
Registriert: 18. Sep 2013, 21:45

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Sludy » 15. Jun 2019, 14:01

Hallo Harry,

vielen Dank für deinen ersten Entwurf. Aktuell würde der Code aber im Reiter "Auswertung" meine vorhandenen Werte in Spalte B ersetzten. Hier ist beispielsweise ein Material "F" enthalten, zu dem in Reiter "Test" aktuell kein Wert vorhanden ist. Dieser wurde nun überschrieben und meine Auswertungsdatei enthält infolge dessen 2x das Material "G". Einmal mit Werten aus dem Array und einmal ohne Werte, da das Array in dem Fall kleiner ist als die Ausgabematrix. Verstehst du/ihr was ich meine?

VG Sludy
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 97
Registriert: 22. Jul 2016, 11:49

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon slowboarder » 15. Jun 2019, 16:20

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
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 25560
Registriert: 18. Apr 2009, 13:33

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon snb » 15. Jun 2019, 16:52

Code: Alles auswählen
Sub M_snb()
   sn = Blatt1.Cells(6, 1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
      .Item(" ") = Array(sn(1, 1), "Summe", sn(1, 3), sn(1, 4), sn(1, 5))
      For j = 2 To UBound(sn)
         sp = Application.Index(sn, j)
         If .exists(sn(j, 1)) Then
            sp = .Item(sn(j, 1))
            sp(2) = sp(2) + sn(j, 2)
        End If
         .Item(sn(j, 1)) = sp
      Next
     
      Tabelle1.Cells(20, 1).Resize(.Count, 5) = Application.Index(.items, 0, 0)
   End With
End Sub


Oder Pivottable:

Code: Alles auswählen
Sub M_snb()
    Application.ScreenUpdating = False
    With ThisWorkbook.PivotCaches.Create(1, Sheets("Test").Cells(6, 1).CurrentRegion).CreatePivotTable(Sheets("Test").Cells(6, 7), "snb")
       For j = 1 To 4
         With .PivotFields(Choose(j, 1, 3, 4, 5))
        .Orientation = 1
        .Position = j
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        End With
        Next
       .AddDataField .PivotFields("Menge"), "Summe", xlSum
        .ColumnGrand = False
        .RowGrand = False
       .RowAxisLayout 1
    End With
End Sub
snb
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6680
Registriert: 25. Sep 2014, 16:37

Re: VBA: Range in Array laden, SVerweis, auslesen

Beitragvon Sludy » 15. Jun 2019, 21:46

Hallo zusammen,

ihr versteht echt alle euer Handwerk. Funktioniert alles echt super. Einfach top eure Lösungen.

Um das ganze nun noch zu krönen, habe ich die Beispieldatei ein letztes mal angepasst. Ich habe in der Datenbasis im Reiter "Test" eine zusätzliche Spalte eingefügt mit einem Datum. Im Reiter "Auswertung" sollen nun zuletzt zusätzlich noch die Mengen aufgeschlüsselt werden, je nachdem in welchem Jahr die Mengen entstanden sind. Also sozusagen nun nicht mehr die Summe zu dem Material sondern nur die Summe in dem bestimmten Jahr gemäß der "Summewenns" Funktion.

Wie sehe da die Codezeile bzgl. der Berechnung aus?

VG Sludy
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 97
Registriert: 22. Jul 2016, 11:49


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: Majestic-12 [Bot], TommyDerWalker und 21 Gäste