Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Werte addieren

Werte addieren
F.Venjacob
Habe eine Tabelle die in Zeile 13 beginnt.
In Spalte 4 befindet sich eine Auftragsnummer, in Spalte 18 ein wichtiger Wert.
Die anderen Spalten (1-3 und 5-17) enthalten Inhalte die nicht bearbeitet werden.
Diese Daten sollen nur beim Datensatz bleiben.
Mein Makro „schaut“ nach der Auftragsnummer in Spalte 4 und addiert alle
Zahlen aus Spalte 18 solange die Auftragsnummer gleich ist. Dann „schreibt“ es die
zusammengefassten Datensatze unter das Wort „Ende“ das zu Beginn des Makros
eingetragen wird. Zudem „schreibt“ es noch den addierten Wert in Spalte 19.
Das funktioniert einwandfrei (obwohl mein Makro aus Expertensicht sicherlich
Umständlich geschrieben wurden). Ich sortiere vorher nach Auftragsnummer.
Ist nur eine Auftragsnummer vorhanden, wird der ganze Datensatz übernommen.
Mein Problem: Jetzt muss noch ein Wert in Spalte 16 berücksichtigt werden.
Das heißt: Addiere alle Werte in Spalte 18 wenn Spalte 4 (Auftragsnummer)
und Spalte 16 (Leistungsnummer) mit dem jeweiligen Wert des nächsten Datensatz übereinstimmen.
Ich hab es schon probiert, kriege es aber nicht hin und bin etwas in Zeitnot.
Hat jemand eine Idee?
Dim SU5, ErstWert, Info As Variant
Dim Felda As String
Dim Feldb As String
Dim Feldc As String
Dim Feldd As String
Dim Felde As String
Dim Feldf As String
Dim Feldg As String
Dim Feldh As String
Dim Feldi As String
Dim Feldj As String
Dim Feldk As String
Dim Feldl As String
Dim Feldm As String
Dim Feldn As String
Dim Feldo As String
Dim Feldp As String
Dim FeldQ As String
Dim FeldR As String
Public Zu_L102blatt As Object

Sub start()
Set Mappe = ThisWorkbook '09_06_08
Set Zu_L102blatt = Mappe.Sheets("Data")
'MsgBox "Das Makro wird nun gestartet. Alle Längen zu einer Nummer werden addiert." & Chr(   _
_
_
13) & "Die aufaddierten Datensätze werden mit einem Kommentar versehen" & Chr(13) & Chr(13) & "  _
_
Die Bearbeitung wird ca. 30 Sekunden dauern. ", vbOKOnly, "F. V.: Makro wird gestartet"
Ende_einf
Addieren
'MsgBox "Die Daten sind jetzt bearbeitet. Alle Längen zu einer Nummer wurden addiert." &  _
Chr(13) & "Beim erneuten Start des Makros mit diesen Datensätzen wird lediglich der Kommentar   _
_
entfernt" & Chr(13) & Chr(13) & "Die Bearbeitung ist abgeschlossen. ", vbOKOnly, "F. V.: Makro  _
ist beendet"
End Sub

Sub Ende_einf()
Sheets("Data").Select
y = 13
anfang = y
While Cells(y, 1) ""
If Cells(y, 1) = "" Then
End If
y = y + 1
Wend
Cells(y + 1, 4) = "Ende"
End Sub

Sub Addieren()
Dim suche As Long
Sheets("Data").Select
zähler = 13
SU5 = 0
suche = Cells(zähler, 4) 'Auftragsnummer
While Cells(zähler, 4) "Ende"
SU5 = SU5 + Cells(zähler, 18) 'Total/Produkt
If Cells(zähler, 4) suche Then
SU5 = SU5 - Cells(zähler, 18)
suche = Cells(zähler, 4)
ErstWert = Cells(zähler - 1, 18)
Cells(zähler - 1, 19) = SU5
Info = ""
If SU5 ErstWert Then
'Cells(zähler - 1, 20) = "Länge aufaddiert"
Info = "add"
End If
ErsteFreiZeile
SU5 = 0
zähler = zähler - 1
End If
Felda = Cells(zähler, 1)
Feldb = Cells(zähler, 2)
Feldc = Cells(zähler, 3)
Feldd = Cells(zähler, 4)
Felde = Cells(zähler, 5)
Feldf = Cells(zähler, 6)
Feldg = Cells(zähler, 7)
Feldh = Cells(zähler, 8)
Feldi = Cells(zähler, 9)
Feldj = Cells(zähler, 10)
Feldk = Cells(zähler, 11)
Feldl = Cells(zähler, 12)
Feldm = Cells(zähler, 13)
Feldn = Cells(zähler, 14)
Feldo = Cells(zähler, 15)
Feldp = Cells(zähler, 16)
FeldQ = Cells(zähler, 17)
FeldR = Info
zähler = zähler + 1
Wend
End Sub

Sub ErsteFreiZeile() 'Datensätze unter den vorhandenen Datensätzen ablegen
Dim EFZ%
Dim wert As Variant
EFZ = Zu_L102blatt.Cells(Rows.Count, 4).End(xlUp).Row + 1
Zu_L102blatt.Cells(EFZ, 1).Value = Felda
Zu_L102blatt.Cells(EFZ, 2).Value = Feldb
Zu_L102blatt.Cells(EFZ, 3).Value = Feldc
Zu_L102blatt.Cells(EFZ, 4).Value = Feldd
Zu_L102blatt.Cells(EFZ, 5).Value = Felde
Zu_L102blatt.Cells(EFZ, 6).Value = Feldf
Zu_L102blatt.Cells(EFZ, 7).Value = Feldg
Zu_L102blatt.Cells(EFZ, 8).Value = Feldh
Zu_L102blatt.Cells(EFZ, 9).Value = Feldi
Zu_L102blatt.Cells(EFZ, 10).Value = Feldj
Zu_L102blatt.Cells(EFZ, 11).Value = Feldk
Zu_L102blatt.Cells(EFZ, 12).Value = Feldl
Zu_L102blatt.Cells(EFZ, 13).Value = Feldm
Zu_L102blatt.Cells(EFZ, 14).Value = Feldn
Zu_L102blatt.Cells(EFZ, 15).Value = Feldo
Zu_L102blatt.Cells(EFZ, 16).Value = Feldp
Zu_L102blatt.Cells(EFZ, 17).Value = FeldQ
Zu_L102blatt.Cells(EFZ, 18).Value = SU5
If Not Info = "" Then
With Zu_L102blatt.Cells(EFZ, 18).AddComment
.Visible = False
.Text "Die Länge wurde aufaddiert"
.Shape.TextFrame.AutoSize = True
End With
End If
End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
hmmmmmmmm.......
06.11.2010 21:39:38
Oberschlumpf
gaaanz vieeel Text + keine Anrede + keine Bsp-Datei.....und auch noch drängeln
insgesamt keine gute Kombi
AW: hmmmmmmmm.......
06.11.2010 22:48:32
F.Venjacob
Sorry,
hab ich zu spät gesehen, dass ich keine Anrede habe. Ok-
Liebe Excel-Spezies,
ich bitte hiermit um Unterstützung zu meinem Problem.
Drängeln will ich selbstverständlich auch nicht.
Gruß Friedel_3
AW: hmmmmmmmm.......
06.11.2010 23:50:20
F.Venjacob
Hallo Leute,
Hier ist meine Datei

Die Datei https://www.herber.de/bbs/user/72179.xls wurde aus Datenschutzgründen gelöscht


Gruß friedel
AW: Werte addieren
07.11.2010 02:22:33
Peter.H
Hallo Friedel
eine alternative Lösung mit einer Pivot Tabelle kann ich dir anbieten.
Da das aber nicht die Frage war, lasse ich die Frage offen.
https://www.herber.de/bbs/user/72181.xls
Gruß
Peter
Anzeige
AW: Werte addieren
07.11.2010 11:20:40
BoskoBiati
Hallo,
1. wäre das wahrscheinlich ohne Makro mit SUMMEWENN / SUMMENPRODUKT zu lösen.
2. Habe ich keine Datei gesehen, aus der hervorgeht, wie das aussieht.
3. Könnte ich mir folgendes Makro vorstellen (ungetestet, ohne Kenntnis der realen Tabelle!):
Sub Addieren()
Dim loLetzte as long
Dim dblSumme as double
with Sheets("DATA")
Loletzte=.cells(rows.count,4).end(xlup).row
dblsumme=application.worksheetfunction.sumif(.Range("D13:D"&loletzte),.Range("D13"),.Range("P13: _
P"&loletzte")
.rows(13).copy .rows(loletzte+1)
.cells(loletzte+1,19)=dblsumme
.cells(loletzte+1,20)="Längen addiert"
end with
End sub
Gruß
Bosko
Anzeige
AW: Werte addieren
07.11.2010 12:47:18
F.Venjacob
Hallo Bosko, erst einmal Danke für deine Unterstützung.
Ich möchte zu meinem Problem noch hinzufügen dass es sich bei der Gesamttabelle um ca. 10.000 Datensätze handelt. Daher hab ich hier nur einen kleinen Ausschnitt angefertigt. Mit Summewenn komme
ich nicht weiter. Ich habe jetzt die Tabelle zur Erklärung noch einmal überarbeitet und hier hinterlegt.
Vielleicht ist es so besser zu verstehen. Deinen Lösungsansatz habe ich getestet; er liefert mir aber nicht das gewünschte Ergebnis und ist so verschachtelt dass ich den Code nicht wirklich verstehe.
https://www.herber.de/bbs/user/72183.xls
Gruß friedel
Anzeige
AW: Werte addieren
07.11.2010 13:40:18
BoskoBiati
Hallo,
hier mit SUMMENPRODUKT, was ich vorhin schon vorgeschlagen hatte:
Arbeitsblatt mit dem Namen 'Data'
 RS
136,006,00
140,640,64
151,001,00
161,20 
170,641,84

ZelleFormel
S13=WENN(SUMMENPRODUKT(($D13:$D$17=D13)*($P13:$P$17=P13))=1;SUMMENPRODUKT(($D$13:$D$17=D13)*($P$13:$P$17=P13);$R$13:$R$17);"")
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Oder als Makro:
Sub Addieren()
Dim loLetzte As Long
Dim rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("DATA")
loLetzte = .Cells(Rows.Count, 4).End(xlUp).Row
.Cells(13, 19).FormulaLocal = "=WENN(SUMMENPRODUKT(($D13:$D$17=D13)*($P13:$P$17=P13))=1; _
SUMMENPRODUKT(($D$13:$D$17=D13)*($P$13:$P$17=P13);$R$13:$R$17);" & """""" & ")"
.Cells(13, 19).AutoFill Destination:=.Range("S13:S" & loLetzte)
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruß
Bosko
Anzeige
AW: Werte addieren
07.11.2010 18:25:29
F.Venjacob
Hallo Bosco,
noch einmal danke ich dir für die Unterstützung.
Ich habe die Formel analog meiner Zeilenmenge verändert.
Es handelt sich jetzt um Zeile 13 bis Zeile 11501.
Leider ist mein Rechner durch die Berechnung blockiert. Habe die
Berechnung schon auf manuell umgestellt. Außerdem habe ich Datensätze
deren Feld in Spalte S leer bleibt. Vielleicht habe ich noch nicht alle Datensätze
sortiert, und der Wert befindet sich an einer anderen Stelle der Tabelle.
Deshalb hätte ich eine VBA-Lösung vorgezogen.
Ich werde jetzt erst einmal die Formel benutzen. Danach versuche ich über
einen Umweg eine VBA-Lösung zu erstellen: Ich werde die Datensätze anhand
der Kriterien untersuchen und bei Gleichheit in Auftragsnummer und Leistungsposition
die Auftragsnummer verändern. Ein Makro dass anschließend alle gleichen
Werte einer Auftragsnummer addiert, habe ich bereits geschrieben, wenn auch mit
umständlichen Code ;-).
Gruß Friedel
Anzeige
AW: Werte addieren
07.11.2010 21:47:24
BoskoBiati
Hallo,
da ich Deine Datei nicht nachbauen kann und will, hier mal ein Ansatz:
Option Explicit
Sub Addieren()
Dim loLetzte As Long
Dim dblSumme As Double
Dim varAuf As Variant
Dim varLeist As Variant
Dim varMen As Variant
Dim varkomb() As Variant
Dim vorh As Boolean
Dim loA As Long
Dim loB As Long
Dim loC As Long
loB = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("DATA")
loLetzte = .Cells(Rows.Count, 4).End(xlUp).Row
ReDim varkomb(3, loLetzte - 13)
Set varAuf = .Range("d14:d" & loLetzte)
Set varLeist = .Range("P14:P" & loLetzte)
Set varMen = .Range("R14:R" & loLetzte)
varkomb(0, loB) = varAuf(0)
varkomb(1, loB) = varLeist(0)
varkomb(2, loB) = varMen(0)
varkomb(3, loB) = 13
For loA = 1 To loLetzte - 13
For loC = 0 To loB
If varAuf(loA) = varkomb(0, loC) And varLeist(loA) = varkomb(1, loC) Then
varkomb(2, loC) = varkomb(2, loC) + varMen(loA)
varkomb(3, loC) = loA + 13
vorh = True
Exit For
End If
Next
If vorh = False Then
loB = loB + 1
varkomb(0, loB) = varAuf(loA)
varkomb(1, loB) = varLeist(loA)
varkomb(2, loB) = varMen(loA)
varkomb(3, loB) = loA + 13
End If
vorh = False
Next
For loA = 0 To loB
.Cells(varkomb(3, loA), 19) = varkomb(2, loA)
Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub
Gruß
bosko
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige