@Peter(silie): Makro hat ne lücke
13.02.2018 13:24:04
Burak
es geht um dein großes Makro mit den Mikrostörungen und Störungen.
Heute ist mir aufgefallen, dass er manche Störungen und Mikrostörungen nicht auflistet. Hab nicht rausgefunden, warum :O
Hier ein Ausschnitt:
R3
A | B | C | D | E | F | G | H | I | J | K | L | M | N | |
3505 | 1270 | 1270398414 | 1 | 34 | NS | I500 | 0 | Fehlalarm | 0 | LAND15 | TSSOP8_P65 | 17.01.2018 | 01:18:32 | |
3506 | 1270 | 1270398413 | 1 | 34 | NS | I403 | 0 | Fehlalarm | 6 | MENI17 | SOL12_P100 | 17.01.2018 | 01:19:06 | |
3507 | 3600 | 3600402289 | 1 | 947 | NS | I702 | 26 | XRAY (AOI) | 0 | GENR49 | BGA_13x15 | 17.01.2018 | 01:34:53 | |
3508 | 3600 | 3600402290 | 1 | 802 | NS | 17.01.2018 | 01:48:15 | |||||||
3509 | 3600 | 3600402291 | 1 | 25 | NS | C661 | 0 | Fehlalarm | 0 | MENI9 | c0805 | 17.01.2018 | 01:48:40 | |
3510 | 3600 | 3600402663 | 1 | 25 | NS | 17.01.2018 | 01:49:05 | |||||||
3511 | 3600 | 3600402664 | 1 | 25 | NS | 17.01.2018 | 01:49:30 | |||||||
3512 | 3600 | 3600402665 | 1 | 25 | NS | 17.01.2018 | 01:49:55 | |||||||
3513 | 3600 | 3600402666 | 1 | 247 | NS | 17.01.2018 | 01:54:02 | |||||||
3514 | 3600 | 3600402667 | 1 | 30 | NS | 17.01.2018 | 01:54:32 | |||||||
3515 | 3600 | 3600402668 | 1 | 30 | NS | 17.01.2018 | 01:55:02 | |||||||
3516 | 3600 | 3600402678 | 1 | 29 | NS | X4 | 0 | Fehlalarm | 18 | MENI17 | PFL20_ERNI | 17.01.2018 | 01:55:31 | |
3517 | 3600 | 3600402679 | 1 | 29 | NS | 17.01.2018 | 01:56:00 | |||||||
3518 | 3600 | 3600402680 | 1 | 29 | NS | 17.01.2018 | 01:56:29 | |||||||
3519 | 3600 | 3600402681 | 1 | 29 | NS | 17.01.2018 | 01:56:58 |
Und die Ausschnitte aus dem Mikrostörungen und Störungen-Tabellenblatt
Mikrostörungen
A | B | C | D | E | F | G | H | I | J | K | L | M | N | |
421 | 1270 | 1270398060 | 1 | 16.01.2018 | 131 | NS | 16.01.2018 | 22:18:28 | ||||||
422 | 1270 | 1270397918 | 1 | 17.01.2018 | 122 | NS | 17.01.2018 | 00:04:35 | ||||||
423 | R4 | |||||||||||||
424 | 6643 | 6643077710 | 1 | 15.01.2018 | 130 | FS | I308 | 0 | Fehlalarm | 1 | MENI-17 | SO8_P127 | 15.01.2018 | 06:48:38 |
Störungen
A | B | C | D | E | F | G | H | I | J | K | L | M | N | |
299 | 1270 | 1270398486 | 1 | 16.01.2018 | 275 | SS | 16.01.2018 | 21:54:48 | ||||||
300 | 1270 | 1270398160 | 1 | 16.01.2018 | 293 | NS | 16.01.2018 | 23:13:16 | ||||||
301 | R4 | |||||||||||||
302 | 6642 | 6642077518 | 1 | 15.01.2018 | 265 | FS | R313 | 0 | Fehlalarm | 0 | MENI9 | MELF1206 | 15.01.2018 | 06:13:59 |
An den Störungstabellen sieht man dass der letzte Eintrag bzw die letzte Störung kurz nach Mitternacht eingetragen wurde. Aber am ersten Ausschnitt erkennt man, dass Zeile 3513 auch hätte mit auf einer der beiden Listen auftauchen müssen.
Und hier noch einmal der aktuelle gesamte Code:
Modul:
Option Explicit
Private sa(1 To 5) As New SheetAverage
Public Sub Stoerungen()
PutAboveAverageIntoSheet "Mikrostörungen", 2, 5
PutAboveAverageIntoSheet "Störungen", 5, 20, True
End Sub
Private Sub PutAboveAverageIntoSheet(ByVal TargetName As String, _
Faktor1 As Long, Faktor2 As Long, _
Optional ByVal RemoveAvrg As Boolean = False)
Dim i As Long, target_ As Worksheet
Dim lRow As Long
Set target_ = ThisWorkbook.Sheets(TargetName)
target_.Cells.Clear
For i = 1 To 5
lRow = target_.Cells(target_.Rows.Count, 1).End(xlUp).Row + 1
target_.Cells(lRow, 1).Value = "R" & i
Set sa(i).DataSheet = ThisWorkbook.Sheets("R" & i)
sa(i).PutAverage
sa(i).CreateIndizes Faktor1, Faktor2
sa(i).PutIndizedValues ThisWorkbook.Sheets(TargetName)
If RemoveAvrg Then sa(i).RemoveAverages
Next i
target_.Columns("N:N").NumberFormat = "hh:mm:ss"
End Sub
Klasse:
Option Explicit
Private indizes_() As Long
Private sh As Worksheet
Public Property Set DataSheet(ByRef this_ As Worksheet)
Set sh = this_
End Property
Public Sub PutAverage()
'Deklaration der Variablen
Dim lRow As Long, flag As String
Dim rng As Range, rng2 As Range
Dim i As Long, j As Long, avrg As Long
With sh
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(2, 1), .Cells(lRow, 1))
flag = .Cells(2, 1).Value
j = 2
For i = 2 To lRow
If rng(i - 1, 1).Value flag Then
Set rng2 = .Range(.Cells(j, 5), .Cells(i - 1, 5))
avrg = Application.WorksheetFunction.TrimMean(rng2, 0.8)
Set rng2 = .Range(.Cells(j, 15), .Cells(i - 1, 15))
rng2.Value = avrg
flag = rng(i, 1)
j = i - 1
End If
Next i
End With
End Sub
Public Sub CreateIndizes(ByVal factor1 As Long, factor2 As Long)
Dim lRow As Long, n As Long
Dim values As Range, averages As Range
Dim v_ As Long, avrg As Long
With sh
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set values = .Range(.Cells(1, 5), .Cells(lRow, 5))
Set averages = .Range(.Cells(1, 15), .Cells(lRow, 15))
For lRow = 2 To values.Rows.Count
v_ = values(lRow, 1).Value
avrg = averages(lRow, 1).Value
If v_ >= avrg * factor1 And v_
Sorry für den langen Post :(Und ich hoffe diese Webdarstellung einiger Zellen fürs Forum sind hier gestattet. Hab das hier bei dem einen oder anderen gesehen.
Freundliche Grüße und Danke