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: 108
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: 108
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: 2247
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: 108
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: 215
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: 108
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: 26141
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: 7048
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: 108
Registriert: 22. Jul 2016, 11:49

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

Beitragvon Sludy » 17. Jun 2019, 12:11

Hallo zusammen,

kann mir jmd. bei der zu dem Thema letzten offenen Frage noch behilflich sein?

Ich danke euch.

Beste Grüße
Sludy
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 108
Registriert: 22. Jul 2016, 11:49

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

Beitragvon snb » 17. Jun 2019, 13:52

Brauchst du ein 'turn key' Antwort ?
Dann: was is dein Budget ?
snb
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 7048
Registriert: 25. Sep 2014, 16:37

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

Beitragvon Sludy » 17. Jun 2019, 22:09

Hallo zusammen,

mit VBA habe ich mich mittlerweile schon ganz gut befasst, nur Array und Dictionary sind wieder totales Neuland. Darüber hinaus findet man zu der Thematik nahe zu nur auf englischen Seiten gute Informationen. Einen nackten Mann kann man zudem nicht in die Tasche greifen ;).

Also was man sicher machen muss, ist für diese Art von Berechnung ein neues / drittes Dictionary zu setzen (Set dict3 = CreateObject("scripting.dictionary")). Zuvor muss natürlich der Bereich des Array's mit der Datenbasis angepasst werden als auch die spätere Ausgabe. Bei dem Part der Berechnung hapert es bei mir. Ich kann mir auch vorstellen, dass ich für das Datum zur Nebenrechnung noch eine zusätzliche Spalte einfügen müsste, wo nur das Kalenderjahr des Datum's angegeben ist und vermutlich darüber ebenfalls ein zusätzliches Array? Aber ich stochere hier arg im dunkeln herum, sodass ich vermutlich nie zeitnah au die richtige Lösung komme -.-".

Beste Grüße
Sludy
Sludy
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 108
Registriert: 22. Jul 2016, 11:49

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

Beitragvon Sludy » 28. Jun 2019, 11:22

Hallo zusammen,

ich möchte das Thema gern nochmal aufgreifen. Ich habe nun ein bisschen herum probiert und denke mein Ansatz ist schonmal nicht ganz so verkehrt, jedoch auch noch nicht voll funktionsfähig.

Code: Alles auswählen
Sub Summe()

Dim t As Double

t = Timer

Dim dict1 As Object
Dim dict2 As Object
Dim dict3 As Object
Dim arr1 As Variant
Dim arr2 As Variant
Dim L As Long

arr1 = Sheets("Test").Range("A7:G20").Value

Set dict1 = CreateObject("scripting.dictionary") '2017
Set dict2 = CreateObject("scripting.dictionary") '2018
Set dict3 = CreateObject("scripting.dictionary") '2019

'Berechnen
For L = 1 To UBound(arr1)
   
    If arr1(L, 4) = "2017" Then
   
        dict1(arr1(L, 1)) = dict1(arr1(L, 1)) + arr1(L, 2)
       
    ElseIf arr1(L, 4) = "2018" Then
   
        dict2(arr1(L, 1)) = dict2(arr1(L, 1)) + arr1(L, 2)
   
    ElseIf arr1(L, 4) = "2019" Then
   
        dict3(arr1(L, 1)) = dict3(arr1(L, 1)) + arr1(L, 2)
   
    Else
     
        'nichts
   
    End If

Next

'Ausgabe
With Sheets("Auswertung")
   
    arr2 = Sheets("Auswertung").Range("B3:I9").Value
   
    For L = 1 To UBound(arr2)
       
        If dict1.exists(arr2(L, 1)) Then
           
            arr2(L, 6) = dict1(arr2(L, 1))
           
        End If
       
        If dict2.exists(arr2(L, 1)) Then
           
            arr2(L, 7) = dict2(arr2(L, 1))
           
        End If

        If dict3.exists(arr2(L, 1)) Then
           
            arr2(L, 8) = dict3(arr2(L, 1))
           
        End If

    Next
   
    Sheets("Auswertung").Range("B3:G9").Value = arr2

End With


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

End Sub

Ich dachte mir im Beispiel pro Spalte ein Dict anzulegen, diese entsprechend je nach Wenn-Bedingung zu füllen und später dann für die Ausgabe wieder zusammenzuführen. In der Beispieldatei (siehe Anhang) funktioniert das für die Spalte G (= Jahr 2017) im Reiter "Auswertung" auch wunderbar. Leider erfolgt jedoch in den beiden darauffolgenden Spalten keine Ergebnisausgabe. Könntet ihr mal schauen, was ich falsch gemacht habe? Kann man meine Lösung darüber hinaus evtl. eleganter lösen?

Ich danke euch für eure Unterstützung.

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: 108
Registriert: 22. Jul 2016, 11:49

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

Beitragvon Sludy » 01. Jul 2019, 17:20

Hallo zusammen,

kann mir bzgl. des Sachverhaltes wirklich keiner mehr weiterhelfen?

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

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

Beitragvon Flotter Feger » 01. Jul 2019, 18:40

Hallöchen lieber Sludy,

ich würde da mal nicht ... kann oder können ... verwenden in der Frage ... stattdessen würde ich persönlich ... will bzw. wollen ... ansetzen.

Es soll ab und zu Helfer abschrecken, wenn man die Vorgaben zu einer Problemstellung innerhalb eines Thread dreimal abändert.
Oder eine mit viel Mühe erstellte eventuelle Lösung mit einem ... "Danke für deinen ersten Entwurf." bezeichnet. Was das beim Helfer impliziert, muss ich, denke ich, nicht weiter ausführen ...

Wenn man dann bei der vierten Änderung keine Antworten mehr bekommt, dass ist dann schon ärgerlich - kann ich absolut nachvollziehen ... und, wenn dann diese zickige Rothaarige, die einem eigentlich helfen könnte ... aber es nicht will (Grund: siehe oben) ... und dann auch noch so einen Quatsch schreibt ...

Immer ruhig bleiben !!! Die spielt nicht ... die will nur beissen ... :roll:
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: 2247
Registriert: 24. Okt 2016, 16:40

Nächste

Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste