HILFE!! gleiche zeilenzelle inhalte addieren

hallo,
ich habe folgendes problem und noch nicht so viel VBA-kenntnisse
um es zufriedenstellend zu loesen.

man stelle sich folgende tabelle1 vor:

a_____20_____01.01.00
a_____25_____01.02.00
a_____15_____01.03.00
.
.
b_____30_____01.01.00
b_____10_____01.02.00
b_____17_____01.03.00
.
.
x______x____________x

nun moechte ich mit einem macro eine tabelle2 erstellen die die
jeweiligen werte von a,b,..,x addiert und den jeweils ersten wert
von a,b,..,x in einer zeile enthaelt.

schema der tabelle2:

a,b,..,x________erster wert_______summe
_______a_________________20__________60
_______b_________________30__________57
.
.
_______x__________________x___________x

ich hoffe ich habe das problem verstaendlich beschrieben
und bedanke mich im vorraus fuer loesungsvorschlaege jeder
art.

mfg hetzel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo


Sub Spezial_Summieren()
Dim nTab1           As Long
Dim nTab2           As Long
Dim ersteZeileTab1  As Integer
Dim ersteZeileTab2  As Integer
Dim anzTab2         As Long
Dim TMP             As String
Dim letzteZeile     As Long
Dim B               As Double
'Erste Zeile (Beginnzeile) mit Buchstabe in Tabelle1
ersteZeileTab1 = 5
'Erste Zeile mit gesammelten (addierten)Artikel in Tabelle2
ersteZeileTab2 = 5
'Letzte Zeile mit einem Wert der Spalte A
letzteZeile = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'wenn nur eine Zeile, dann Abbruch
If ersteZeileTab1 = letzteZeile Then Exit Sub
'Schritt 1
anzTab2 = 0
'Alle Buchstaben der Tabelle1 nacheinander durchlaufen
For nTab1 = ersteZeileTab1 To letzteZeile
'Überprüfen, ob Buchstabe der Tabelle1 schon in Liste der Tabelle2 vorkommt
TMP = Sheets(1).Cells(nTab1, 1)
For nTab2 = ersteZeileTab2 To (ersteZeileTab2 + anzTab2 - 1)
If TMP = Sheets(2).Cells(nTab2, 1) Then   'genaue Übereinstimmuung
GoTo Nächster_Artikel
End If
Next nTab2
'Buchstabe in Tabelle2 eintragen
Sheets(2).Cells(ersteZeileTab2 + anzTab2, 1) = Sheets(1).Cells(nTab1, 1)
'Erster Wert der Spalte B eintragen
Sheets(2).Cells(ersteZeileTab2 + anzTab2, 2) = Sheets(1).Cells(nTab1, 2)
'Anzahl der gesammelten Buchstaben um 1 erhöhen
anzTab2 = anzTab2 + 1
Nächster_Artikel:
Next nTab1
'Schritt 2
For nTab2 = ersteZeileTab2 To (ersteZeileTab2 + anzTab2 - 1)
For nTab1 = ersteZeileTab1 To letzteZeile
If Sheets(1).Cells(nTab1, 1) = Sheets(2).Cells(nTab2, 1) Then
B = B + Sheets(1).Cells(nTab1, 2)
End If
Next nTab1
'Werte in Tabelle2 schreiben
Sheets(2).Cells(nTab2, 3) = B
Next nTab2
End Sub

mfg, GraFri

Function AddKey(Key As Range, Summe As Range) ' 03(C)oded by hw - Return Array(n,3) - no Errorchecking Dim KeySum() Dim KeyCode As New Collection Dim i As Long ReDim KeySum(1 To Summe.Rows.Count, 1 To 3) On Error Resume Next For i = 1 To Summe.Rows.Count KeyCode.Add i, CStr(Key(i)) If Err.Number = 0 Then KeySum(KeyCode.Count, 1) = Key(i) KeySum(KeyCode.Count, 2) = Summe(i) KeySum(KeyCode.Count, 3) = Summe(i) Else Err.Clear KeySum(KeyCode(Key(i)), 3) = KeySum(KeyCode(Key(i)), 3) + Summe(i) End If Next AddKey = KeySum End Function

Beliebteste Forumthreads (12 Monate)

HILFE!! gleiche zeilenzelle inhalte addieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

HILFE!! gleiche zeilenzelle inhalte addieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread