Summieren mit Unterbrechung

Forumthread: Summieren mit Unterbrechung

19.12.2019 14:51:49

Epstein

Guten Tag,
anhand folgender Beispieldatei möchte ich gerne mein Problem schildern:
https://www.herber.de/bbs/user/133871.xlsx
Und zwar möchte ich gerne die Rüstvorgänge eines Werkzeuges erfassen.
Tabelle 1 wird täglich fortgeführt und das Ergebnis (Anzahl Rüstvorgänge eines Werkzeuges) sollen in Tabelle 2 ausgegeben werden.
Problem dabei ist, dass jede Schicht die aktuelle Maschinenbelegung dokumentiert. Als Beispiel kann man das Werkzeug 629 nennen. Es wurde in der Tabelle 6x erwähnt, dennoch war es nur ein Rüstvorgang. Danach lief das Werkzeug 999 auf der Maschine.
Sollte das Werkzeug 629 im weiteren zeitlichen Verlauf wieder auf der Maschine 237 laufen, soll dies als 2. Rüstvorgang gewertet werden.
Es kann durchaus vorkommen das ein Werkzeug mal auf der 238 lief, dann mal auf der 237. Mir würde es aber genügen wenn man die Maschinen einzeln betrachtet und die Rüstvorgänge des Werkzeuges auf den verschiedenen Maschinen summiert.
Ich hoffe ich habe mein Problem verständlich geschildert.
Gruß&Danke

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Summieren mit Unterbrechung

19.12.2019 15:02:03

Daniel
AW: Summieren mit Unterbrechung

20.12.2019 07:55:37

Epstein
AW: Summieren mit Unterbrechung

25.12.2019 19:56:05

Dieter

AW: Summieren mit Unterbrechung

19.12.2019 15:02:03

Daniel

Hi
du müsstest zunächst passen sortieren, dh nach
Maschine - Datum - Schicht, wobei du darauf achten musst, dass die Schichten auch zeitlich richtig sortiert werden, dh wenn die alphabetische Reichenfolge nicht passt, müsstest du umbennnen in "1 Früh", "2 Spät", "3 Nacht", damit die Spätschicht vor der Nachtschicht des gleichen Tages kommt.
dann kannst du in einer Hilfsspalte die Wechsel zählen, immer wenn in einer Zeile ein anderes Werkzeug steht als in der Zeile drüber, lässt du dir eine 1 ausgeben.
dann kannst du in dieser Spalte die Rüstvorgänge zählen.
Gruß Daniel

AW: Summieren mit Unterbrechung

20.12.2019 07:55:37

Epstein

Danke für deine Antwort. Nur wie sieht eine solche Formel aus, die immer eine 1 ausgibt wenn ein Zahlenwechsel vorliegt ?
Uund im Grund genommen würde ich dann ja für jedes Werkzeug eine Hilfsspalte benötigen. Bei knapp 1400 Werkzeugen eher suboptimal.
Ich würde es gerne so haben, dass ich die Tabelle als solches nicht nach Maschine o. Werkzeug o. Schicht sortieren müssten, da diese täglich von drei verschiedenen Personen gepflegt wird.

AW: Summieren mit Unterbrechung

25.12.2019 19:56:05

Dieter

Hallo Epstein,
ich schlage für dein Problem die folgende VBA-Lösung vor:

Sub Verarbeitung()
Dim arr As Variant
Dim dic As Object
Dim i As Long
Dim letzteZeileH As Long
Dim letzteZeileR As Long
Dim sortBereich As Range
Dim wb As Workbook
Dim werkzeug As Long
Dim wsH As Worksheet
Dim wsR As Worksheet
Dim wsT1 As Worksheet
Dim zeileH As Long
Dim zeileR As Long
Set wb = ThisWorkbook
Set wsH = wb.Worksheets("Hilfsblatt")
wsH.UsedRange.ClearContents
Set wsT1 = wb.Worksheets("Tabelle1")
letzteZeileH = wsT1.Cells(wsT1.Rows.Count, "A").End(xlUp).Row
If letzteZeileH = 1 Then
MsgBox "Keine Daten"
Exit Sub
End If
wsT1.Range("A1").Resize(letzteZeileH, 4).Copy Destination:=wsH.Range("A1")
For zeileH = 2 To letzteZeileH
wsH.Cells(zeileH, "D") = zeileH - 1
Next zeileH
Set sortBereich = wsH.Range("A1").Resize(letzteZeileH, 4)
With wsH.Sort
With .SortFields
.Clear
.Add Key:=wsH.Range("B2")
.Add Key:=wsH.Range("A2")
.Add Key:=wsH.Range("D2")
End With
.SetRange Rng:=sortBereich
.Header = xlYes
.Apply
End With
Set wsR = wb.Worksheets("Rüstvorgänge")
letzteZeileR = wsR.Cells(wsR.Rows.Count, "A").End(xlUp).Row
If letzteZeileR > 1 Then
wsR.Range("A2").Resize(letzteZeileR - 1, 4).ClearContents
End If
Set dic = CreateObject("Scripting.Dictionary")
zeileR = 2
For zeileH = 2 To letzteZeileH
werkzeug = wsH.Cells(zeileH, "C")
If werkzeug  wsH.Cells(zeileH + 1, "C") And _
wsH.Cells(zeileH, "B") = wsH.Cells(zeileH + 1, "B") Then
' Es liegt ein Rüstvorgang vor
If dic.Exists(Key:=werkzeug) Then
dic.Item(werkzeug) = dic.Item(werkzeug) + 1
Else
dic.Add Key:=werkzeug, _
Item:=1
End If
End If
Next zeileH
arr = dic.Keys
For i = LBound(arr) To UBound(arr)
wsR.Cells(i + 2, "A") = arr(i)
wsR.Cells(i + 2, "B") = dic.Item(arr(i))
Next i
letzteZeileR = i + 1
Set dic = Nothing
Set sortBereich = wsR.Range("A1").Resize(letzteZeileR, 2)
With wsR.Sort
With .SortFields
.Clear
.Add Key:=wsR.Range("A2")
End With
.SetRange Rng:=sortBereich
.Header = xlYes
.Apply
End With
wsR.Activate
wsR.Range("A1").Activate
End Sub

Das Programm benötigt ein Hilfsblatt, welches du auch ausblenden kannst, falls es die Optik stört.
https://www.herber.de/bbs/user/133968.xlsm
Viele Grüße und noch schöne Feiertage
Dieter

Beliebteste Forumthreads (12 Monate)

Forumthread: Summieren mit Unterbrechung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread