Das Archiv des Excel-Forums
Fehler im Makro?
- Fehler im Makro? von ChrisO vom 02.10.2003 15:45:14
- AW: Fehler im Makro? - von Björn B. am 03.10.2003 16:05:16
- AW: Fehler im Makro? - von GraFri am 04.10.2003 06:37:41
- AW: Fehler im Makro? - von GraFri am 04.10.2003 15:49:10
- Danke!!! - von ChrisO am 06.10.2003 09:28:45
- kleinen Fehler entdeckt... - von ChrisO am 06.10.2003 10:53:08
- Danke!!! - von ChrisO am 06.10.2003 09:28:45
- AW: Fehler im Makro? - von GraFri am 04.10.2003 15:49:10
- AW: Fehler im Makro? - von Björn B. am 03.10.2003 16:05:16
 |
Betrifft: Fehler im Makro?
von: ChrisO
Hi,
wollte aus einer Tabelle die doppelten Daten zusammenfassen und die Werte in den Spalten rechts daneben addieren. Habe nach Recherche im Archiv auch ein Makro gefunden, das ich auf meine Bedürfnisse angepasst habe:
Sub doppelsummieren()
Dim m%, erstezeile%, letztezeile As Long, n%, z%
'Erste Zeile mit einem Wert
erstezeile = 11
'Letzte Zeile mit einem Wert
letztezeile = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
ReDim v(65000, 9)
m = 4
For z = erstezeile To letztezeile
For n = 4 To m
If v(n, 0) = Worksheets(1).Cells(z, 1) Then GoTo nächste
Next
m = m + 1
v(m - 1, 0) = Worksheets(1).Cells(z, 1)
v(m - 1, 1) = Worksheets(1).Cells(z, 2)
nächste:
Next
For z = erstezeile To letztezeile
For i = 4 To m
If v(i, 0) = Worksheets(1).Cells(z, 1).Value Then
v(i, 2) = v(i, 2) + Worksheets(1).Cells(z, 3).Value
v(i, 3) = v(i, 3) + Worksheets(1).Cells(z, 5).Value
v(i, 4) = v(i, 4) + Worksheets(1).Cells(z, 6).Value
v(i, 5) = v(i, 5) + Worksheets(1).Cells(z, 8).Value
v(i, 7) = v(i, 7) + Worksheets(1).Cells(z, 10).Value
End If
Next
Next
For i = 0 To m
For sp = 0 To 9
Worksheets(2).Cells(i + 1, sp + 1) = v(i, sp)
Next
Next
End Sub
Es addiert bei doppelten Werten jeweils die Spalten C, E, F, H und J.
Leider wird alles was auf dem Ziel-Blatt steht (also Überschriften und Formeln) gelöscht bzw. mit leeren Zellen überschrieben. Bin blutiger VBA-Anfänger. Vielleicht kann mir also jemand helfen den Fehler zu finden?
Gruß
Chris
Zur Demonstration hier eine abgespeckte Version der Datei
 |
Betrifft: AW: Fehler im Makro?
von: Björn B.
Geschrieben am: 03.10.2003 16:05:16
Hallo Chris,,
in dem Code
For i = 0 To m
For sp = 0 To 9
Worksheets(2).Cells(i + 1, sp + 1) = v(i, sp)
Next
Next
liegt der Fehler.
Da du die zweite Schleife von 0 bis 9 durchlaufen lässt, überschreibt Du Deine Formeln in der Zieltabelle.
Gruß
Björn
|
Betrifft: AW: Fehler im Makro?
von: GraFri
Geschrieben am: 04.10.2003 06:37:41
Hallo
Hat zwar etwas gedauert - bei weiteren Fragen melden.
'Vorgangsweise:
'
'Schritt 1
'alle Artikel der Tabelle1 werden nacheinander durchlaufen und die einzelne
'Artikel-Namen in Tabelle2 eingetragen
'
'Schritt 2
'Jeder Artikel der Tabelle2 wird mit Tabelle1 verglichen, die Werte addiert,
'eingetragen und die Formel eingefügt
Sub Doppelte_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 C As Double
Dim E As Double
Dim F As Double
Dim H As Double
Dim J As Double
'Erste Zeile mit einem Artikel in Tabelle1
ersteZeileTab1 = 11
'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 ersteZeile = letzteZeile Then Exit Sub
'Schritt 1
'--------------------------------------------------------------------
anzTab2 = 0
'Alle Artikel der Tabelle1 nacheinander durchlaufen
For nTab1 = ersteZeileTab1 To letzteZeile
'Überprüfen, ob Artikel 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
If Right(TMP, 1) = "A" Then ' A als letzter Buchstabe
If Left(TMP, Len(TMP) - 2) = Sheets(2).Cells(nTab2, 1) Then
GoTo Nächster_Artikel
End If
End If
Next nTab2
'Artikelbezeichnung in Tabelle2 eintragen
Sheets(2).Cells(ersteZeileTab2 + anzTab2, 1) = Sheets(1).Cells(nTab1, 1)
'Anzahl der gesammelten Artikel 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 InStr(Sheets(1).Cells(nTab1, 1), Sheets(2).Cells(nTab2, 1)) Then
C = C + Sheets(1).Cells(nTab1, 3)
E = E + Sheets(1).Cells(nTab1, 5)
F = F + Sheets(1).Cells(nTab1, 6)
H = H + Sheets(1).Cells(nTab1, 8)
J = J + Sheets(1).Cells(nTab1, 10)
End If
Next nTab1
With Sheets(2)
'Werte in Tabelle2 schreiben
.Cells(nTab2, 3) = C
.Cells(nTab2, 4) = E
.Cells(nTab2, 5) = F
.Cells(nTab2, 6) = H
.Cells(nTab2, 8) = J
'Formel eintragen
.Cells(nTab2, 7).Formula = "=$F$" & nTab2 & "/24"
.Cells(nTab2, 9).Formula = "=$H$" & nTab2 & "/24"
End With
Next nTab2
End Sub
Code eingefügt mit Syntaxhighlighter 2.4
mfg, GraFri
|
Betrifft: AW: Fehler im Makro?
von: GraFri
Geschrieben am: 04.10.2003 15:49:10
Hallo
Leider kleiner Fehler
statt
If ersteZeile = letzteZeile Then Exit Sub
If ersteZeileTab1 = letzteZeile Then Exit Sub
verwenden
mfg, GraFri
|
Betrifft: Danke!!!
von: ChrisO
Geschrieben am: 06.10.2003 09:28:45
Hi,
vielen Dank euch beiden. Das Makro funktioniert super!
Gruß
Chris
PS: Bedanke mich erst jetzt, da langes Wochenende = frei!!!
|
Betrifft: kleinen Fehler entdeckt...
von: ChrisO
Geschrieben am: 06.10.2003 10:53:08
Hattest noch vergessen die Variablen C, E... auf null zu setzen. Aber ich kann ja auch was schaffen ;-)
Nochmals Danke
| |
