HILFE!! gleiche zeilenzelle inhalte addieren

• HILFE!! gleiche zeilenzelle inhalte addieren von HetzelW vom 04.10.2003 14:21:15
  • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von Ramses am 04.10.2003 14:33:40
    • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von HetzelW am 04.10.2003 14:54:13
      • Formellösung - von IngoG am 04.10.2003 15:36:56
  • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von GraFri am 04.10.2003 15:15:16
    • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von HetzelW am 04.10.2003 16:14:00
  • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von Hans W. Hofmann am 04.10.2003 16:27:01
    • AW: HILFE!! gleiche zeilenzelle inhalte addieren - von Hans W. Hofmann am 04.10.2003 17:05:36

Betrifft: HILFE!! gleiche zeilenzelle inhalte addieren
von: HetzelW
Geschrieben am: 04.10.2003 14:21:15

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

  
 
A
B
C
1
Artikel
Preis
Datum
2
a
1
01.01.2003
3
a
2
02.01.2003
4
a
3
03.01.2003
5
a
4
04.01.2003
6
a
5
05.01.2003
7
a
6
06.01.2003
8
a
7
07.01.2003
9
a
8
08.01.2003
10
b
9
09.01.2003
11
b
10
10.01.2003
12
b
11
11.01.2003
13
b
12
12.01.2003
14
b
13
13.01.2003
15
b
14
14.01.2003
16
b
15
15.01.2003
17
b
16
16.01.2003
18
b
17
17.01.2003
19
b
18
18.01.2003
20
c
19
19.01.2003
21
c
20
20.01.2003
22
c
21
21.01.2003
23
c
22
22.01.2003
24
c
23
23.01.2003
25
c
24
24.01.2003
26
c
25
25.01.2003
27
c
26
26.01.2003

  
 
A
B
C
1
Artikel
Preis
Datum
2
Gesamtergebnis
351
 
3
a Summe
36
 
4
a
1
01.01.2003
5
a
2
02.01.2003
6
a
3
03.01.2003
7
a
4
04.01.2003
8
a
5
05.01.2003
9
a
6
06.01.2003
10
a
7
07.01.2003
11
a
8
08.01.2003
12
b Summe
135
 
13
b
9
09.01.2003
14
b
10
10.01.2003
15
b
11
11.01.2003
16
b
12
12.01.2003
17
b
13
13.01.2003
18
b
14
14.01.2003
19
b
15
15.01.2003
20
b
16
16.01.2003
21
b
17
17.01.2003
22
b
18
18.01.2003
23
c Summe
180
 
24
c
19
19.01.2003
25
c
20
20.01.2003
26
c
21
21.01.2003
27
c
22
22.01.2003
28
c
23
23.01.2003
29
c
24
24.01.2003
30
c
25
25.01.2003
31
c
26
26.01.2003

  
 
A
B
C
36
Artikel
Preis
Datum
37
Gesamtergebnis
351
 
38
a Summe
36
 
39
b Summe
135
 
40
c Summe
180
 

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

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
 
 
 
 

Beiträge aus den Excel-Beispielen zum Thema " HILFE!! gleiche zeilenzelle inhalte addieren "