Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1552to1556
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

VBA: Bereinigen einer Tabelle nach Auslöser

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
Anzeige
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
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige