VBA: Bereinigen einer Tabelle nach Auslöser

Forumthread: VBA: Bereinigen einer Tabelle nach Auslöser

27.04.2017 19:26:24

David

Hallo zusammen,
da ich mit meinen VBA-Kenntnissen nicht weiter komme, wollte ich hier nach Hilfe fragen.
Ich habe mehrere Tabellen, die nach folgendem Schema aufgebaut sind (die ca. 600 Werte stehen ohne leere Zeilen direkt untereinander, hier nur zur Übersicht freigelassen):
Zeitstempel | Dauer | Wagonnummer
13.02.2017 15:01:34 | 00:00:25 | Wagon 1
13.02.2017 15:01:34 | 00:00:17 | Wagon 2
13.02.2017 15:01:34 | 00:00:12 | Wagon 8
13.02.2017 15:01:34 | 00:00:04 | Wagon 9
13.02.2017 15:01:35 | 00:00:34 | Wagon 3
13.02.2017 15:01:35 | 00:00:31 | Wagon 4
13.02.2017 19:24:36 | 00:00:02 | Wagon 3
13.02.2017 19:24:36 | 00:00:03 | Wagon 4
13.02.2017 19:24:36 | 00:00:01 | Wagon 6
13.02.2017 19:24:36 | 00:00:03 | Wagon 2
Die Tabelle zeigt an, wann und wie lange welcher Wagon zum Stehen kommt. Jetzt möchte ich die Liste so bereinigen (Zeilen löschen), so dass nur noch der verursachende Wagon stehen bleibt.
Als Erklärung:
A) um 15:01:34/35 bleiben stehen 1-2-3-4 und 8-9, Auslöser sind je Wagon 1 und 8
B) um 19:24:36 bleiben stehen 2-3-4-6, Auslöser ist hier Wagon 2
Wie in A) zu sehen soll die zeitliche Toleranz des Zeitstemepls 00:00:03 sein (bsw. 15:01:34 bis 15:01:37 als ein Zeitintervall), außerdem wie in B) darf es höchstens eine Lücke(Wagon 5 fehlt) geben.
Ich hoffe es ist halbwegs klar worum es geht.
Vielen Dank schon mal im voraus.
MfG David

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA: ein Versuch

27.04.2017 22:06:57

Fennek
AW: 2. Version

29.04.2017 14:43:25

Fennek

AW: VBA: ein Versuch

27.04.2017 22:06:57

Fennek

Hallo,
anbei ein Versuch, der Makro braucht auch für die paar Zahlen erstaunlich lange. Es ist also eher ein "proof-of-concept"
https://www.herber.de/bbs/user/113163.xlsm
Falls in den Original-Daten es nicht "Wagon 1" usw heist, sind Anpassungen notwendig.
mfg

AW: 2. Version

29.04.2017 14:43:25

Fennek

Hi,
die erste Verion war ziemlich "verunglückt", zu umständlich und die Performance war schlecht.
Die zweite Version:


Dim WS As Worksheet
Sub Fen()
Anf = Timer
Columns("C").Interior.ColorIndex = xlNone
Range("D2:D1000").Clear
Block
Set WS = ActiveSheet
With WS.Sort
With .SortFields
.Clear
.Add Key:=WS.Range("D2")
.Add Key:=WS.Range("C2")
End With
.Header = xlYes
.SetRange Rng:=WS.UsedRange
.Apply
End With
'markieren
lr = WS.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
If WS.Cells(i, "D")  B Then
'WS.Cells(i, "C").Interior.Color = vbYellow
Farbe (i)
B = WS.Cells(i, "D")
'N = CInt(Split((Trim(WS.Cells(i, "C"))))(1))
N = NN(i)
Else
If N + 2

https://www.herber.de/bbs/user/113196.xlsm
mfg

Beliebteste Forumthreads (12 Monate)

VBA: Bereinigen einer Tabelle nach Auslöser

Forumthread: VBA: Bereinigen einer Tabelle nach Auslöser

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread