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