Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1608to1612
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

@Peter(silie): Makro hat ne lücke

@Peter(silie): Makro hat ne lücke
13.02.2018 13:24:04
Burak
Hi Peter und auch alle anderen bei Interesse,
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

 ABCDEFGHIJKLMN
3505127012703984141 34NSI5000Fehlalarm0LAND15TSSOP8_P6517.01.201801:18:32
3506127012703984131 34NSI4030Fehlalarm6MENI17SOL12_P10017.01.201801:19:06
3507360036004022891 947NSI70226XRAY (AOI)0GENR49BGA_13x1517.01.201801:34:53
3508360036004022901 802NS      17.01.201801:48:15
3509360036004022911 25NSC6610Fehlalarm0MENI9c080517.01.201801:48:40
3510360036004026631 25NS      17.01.201801:49:05
3511360036004026641 25NS      17.01.201801:49:30
3512360036004026651 25NS      17.01.201801:49:55
3513360036004026661 247NS      17.01.201801:54:02
3514360036004026671 30NS      17.01.201801:54:32
3515360036004026681 30NS      17.01.201801:55:02
3516360036004026781 29NSX40Fehlalarm18MENI17PFL20_ERNI17.01.201801:55:31
3517360036004026791 29NS      17.01.201801:56:00
3518360036004026801 29NS      17.01.201801:56:29
3519360036004026811 29NS      17.01.201801:56:58


Und die Ausschnitte aus dem Mikrostörungen und Störungen-Tabellenblatt
Mikrostörungen

 ABCDEFGHIJKLMN
42112701270398060116.01.2018131NS      16.01.201822:18:28
42212701270397918117.01.2018122NS      17.01.201800:04:35
423R4             
42466436643077710115.01.2018130FSI3080Fehlalarm1MENI-17SO8_P12715.01.201806:48:38


Störungen

 ABCDEFGHIJKLMN
29912701270398486116.01.2018275SS      16.01.201821:54:48
30012701270398160116.01.2018293NS      16.01.201823:13:16
301R4             
30266426642077518115.01.2018265FSR3130Fehlalarm0MENI9MELF120615.01.201806: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

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

Betreff
Datum
Anwender
Anzeige
AW: @Peter(silie): Makro hat ne lücke
14.02.2018 09:43:26
Burak
habe eine weitere wichtige Information rausgefunden. Für jede Linie (Linienblatt R1, R2, ..., R5) untersucht er jedes Mal den letzten Auftrag nicht nach Störungen udn Mikrostörungen.
also
Beispiel

 ABCDEFG
112700,291874410,812966670,362118620,957018240,662582580,89249854
212700,725354440,142619870,819375170,07771990,1372110,08429735
333600,887516360,335029250,130489490,720440810,28524020,99192664
433600,783798040,104050150,51257910,497151550,940172940,64756615
533600,709629790,475202650,424414080,750572380,391674520,33491733
612700,337602960,14509380,073057270,683046910,127356430,92905612
712700,112786420,814430290,747675570,577649530,233648240,09467862
833600,364466640,301297780,704959140,327809420,972131660,38400362
933600,969084190,997987230,520093860,669995240,044254970,93453239
1012800,899032240,855605240,723824530,326644250,382815780,7884869
1112800,809927790,532604360,761605040,902509930,424383740,39649168
1233600,142190130,298351040,582196940,65470120,460527460,14016912
1333600,163318890,705609550,176587310,466640260,130031880,1367373


hier sucht er die Zeilen mit der rot markierten Zelle nicht durch.
Egal wie wieviele zahlenwechsel zuvor statt fanden oder wie oft die selbe Zahl dran kam. der letzte Auftrag wird immer nicht durchsucht.
Hoffe das hilft bei der Fehlersuche.
Anzeige
AW: gelöst, closed
14.02.2018 10:38:35
Burak
Problem gelöst, Schleifenrange um 1 erweitert.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige