|
Werte Spezialisten. Habe folgendes Problem:
Ich habe einen VBA code der genau das tut was ich will, nur die Spalten sollen anders aufgeteilt werden und ich bekomme das nicht hin.
Tabelle 1 = In Spalte A verschiedene Artnr. die immer wieder mal auch doppelt vorkommen können (Zeile 1 trägt Überschrift der Spalten). In Spalte B die Bezeichnung der Artikel, die natürlich dann auch immer wieder mal doppelt vorkommen und in Spalte E die Stückzahl auf Lager.
Tabelle 2 = Ausgabe: der code schreibt nun in Spalte A die Artikelnummer (nur einmal), in Spalte B die Bezeichnung und in Spalte E die Summer der addierten Stück aus Spalte E der Tabelle 1.
Alles Bestens.
Ich brauche jetzt aber eine andere Spaltenaufteilung und das bekomme ich nicht hin.
Spalte A sollte Spalte S werden; Spalte B sollte Spalte L werden und Spalte E sollte Spalte I werden.
Bitte um eure Hilfe, vielen Dank!!
hier der Code:
Option Explicit
Sub Summe_Datenbereich()
Dim ArreayData()
Dim oDicBezeichnung As Object, oDicSumme As Object
Dim A&
Set oDicBezeichnung = CreateObject("Scripting.Dictionary")
Set oDicSumme = CreateObject("Scripting.Dictionary")
With Tabelle1
oDicBezeichnung(.Range("A1")) = .Range("B1")
oDicSumme(.Range("A1")) = .Range("E1")
ArreayData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 5).Value2
End With
For A = 1 To UBound(ArreayData)
If oDicBezeichnung.exists(ArreayData(A, 1)) Then
oDicSumme(ArreayData(A, 1)) = oDicSumme(ArreayData(A, 1)) + ArreayData(A, 5)
Else
oDicBezeichnung(ArreayData(A, 1)) = ArreayData(A, 2)
oDicSumme(ArreayData(A, 1)) = ArreayData(A, 5)
End If
Next A
With Tabelle2
.Range("A1:E1").EntireColumn.Clear
.Range("A1").Resize(oDicSumme.Count) = Application.Transpose(oDicBezeichnung.keys)
.Range("B1").Resize(oDicSumme.Count) = Application.Transpose(oDicBezeichnung.items)
.Range("E1").Resize(oDicSumme.Count) = Application.Transpose(oDicSumme.items)
.Rows(1).Font.Bold = True
.Range("A1:E1").EntireColumn.AutoFit
.Activate
End With
End Sub
|