AW: Summe gleiche artikel mit menge VBA
28.08.2007 23:01:58
Gerd
Hallo Karel,
der fachlich interessantere Code ist derjenige von Sepp.
Nullwerte in Spalte B mitübertragen. Da muss eine Bedingung raus.
Sub test()
Dim vnt1(), vnt2(), vnt3(), i As Long, j As Long, lngIndex As Long
With Worksheets("Tabelle1")
vnt1 = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim vnt2(1 To .Cells(Rows.Count, 1).End(xlUp).Row - 1)
ReDim vnt3(1 To .Cells(Rows.Count, 1).End(xlUp).Row - 1)
End With
For i = 1 To UBound(vnt1, 1)
lngIndex = 0
On Error Resume Next
lngIndex = WorksheetFunction.Match(CLng(vnt1(i, 1)), vnt2, 0)
On Error GoTo 0
'If vnt1(i, 2) 0 Then - weglassen!
If lngIndex = 0 Then
j = j + 1
vnt2(j) = vnt1(i, 1)
vnt3(j) = vnt1(i, 2)
Else
vnt3(lngIndex) = vnt3(lngIndex) + vnt1(i, 2)
'End If -- weglassen!
End If
Next
With Worksheets("Tabelle2")
.Columns("A:B").ClearContents
.Range("A2:A" & (UBound(vnt2) + 1)).Value = WorksheetFunction.Transpose(vnt2)
.Range("B2:B" & (UBound(vnt3) + 1)).Value = WorksheetFunction.Transpose(vnt3)
.Range("A1").Value = "Artikel"
.Range("B1").Value = "Bestand"
End With
End Sub
Aus mehreren Tabellen einlesen - mal sehen, wäre noch auszuknobeln.
(Die Obergrenze der Datensätze insgesamt dürfte bei Nummer letzte Zeile -1= 65535 liegen.)
Gruß Gerd