VBA: Range in Array laden, Berechnung, auslesen

Moderator: ModerationP

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

Beitragvon Sludy » 06. Jun 2019, 12:07

Hallo zusammen,

vielen Dank an alle Beteiligten. Ich habe mich aktuell für den Code von "Steuerfuzzi" entschieden (siehe nachfolgend).

Code: Alles auswählen
Sub Summe()

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
ReDim arr2(1 To UBound(arr), 1 To 1)

For L = 1 To UBound(arr)
    arr2(L, 1) = dict(arr(L, 1))
Next

'Ausgabe
Sheets("Test").Range("C7").Resize(UBound(arr2)).Value = arr2

End Sub

Wie kann man jedoch folgende Zeilen ins "deutsche" übersetzen?

Code: Alles auswählen
For L = 1 To UBound(arr)
    dict(arr(L, 1)) = dict(arr(L, 1)) + arr(L, 2)
Next
ReDim arr2(1 To UBound(arr), 1 To 1)

For L = 1 To UBound(arr)
    arr2(L, 1) = dict(arr(L, 1))
Next

Ich habe zudem die Beispieldatei mal noch modifiziert. Wie würde der Code aussehen, wenn man nun nicht mehr die Summen wie bisher im Reiter "Test" in der Spalte C ausgibt, sondern jeweils nur einmal im Reiter "Auswertung" in Spalte C gemäß der korrekten Materialnummer in Spalte B?

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

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

Beitragvon Der Steuerfuzzi » 06. Jun 2019, 13:20

Variante 1:
Die Materialbezeichnungen stehen schon in der Tabelle "Auswertung" und es wird nur noch der Wert zu den darin stehenden Materialien eingefügt:
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("C3").Resize(UBound(arr2)).Value = arr2

End Sub


Variante 2:
Die Eintragungen auf dem Blatt "Auswertung" werden gelöscht und es wird komplett neu eingefügt:
Code: Alles auswählen
Sub Summe2()

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

'Ausgabe bei nicht mehr als 65536 verschiedenen Materialbezeichnungen
'sollten es mehr sein oder werden, dann müsste man das Dictionary zuerst in
'ein Array "umspeichern"
With Sheets("Auswertung")
    .Range("B3", .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 2).ClearContents
    .Range("B3").Resize(dict.Count).Value = Application.Transpose(dict.keys)
    .Range("C3").Resize(dict.Count).Value = Application.Transpose(dict.items)
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range( _
            "B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        .SetRange Range("B2:C9")
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With

End Sub
Gruß
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3715
Registriert: 25. Mär 2013, 13:28

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

Beitragvon Sludy » 07. Jun 2019, 07:31

Hallo Michael,

Variante 1 ist genau das was ich verfolge. Funktioniert wunderbar. Danke dir für deinen Input.

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

Vorherige

Zurück zu Excel Forum (provisorisch)

Wer ist online?

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