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

Zweite Bedingung mit anderem Tabellenblatt dazu

Zweite Bedingung mit anderem Tabellenblatt dazu
12.02.2018 08:18:50
Burak
Guten Morgen,
also ich habe hier im Forum letztes Mal ein super Code bekommen, aber der mir zu hoch ist :D
An Stellen, die ich verstanden habe, konnte ich einige Anpassungen vornehmen, aber ein gravierender Teil fehlt noch.
Der Modulcode:

Option Explicit
Public Sub PutAboveAverageIntoSheet()
Dim sa(1 To 5) As New SheetAverage
Dim target2_ As Worksheet, target_ As Worksheet
Dim lRow As Long, i As Long
Set target_ = ThisWorkbook.Sheets("Mikrostörungen")
Set target2_ = ThisWorkbook.Sheets("Störungen")
target_.Cells.Clear
target2_.Cells.Clear
For i = 1 To 5
lRow = target2_.Cells(target2_.Rows.Count, 1).End(xlUp).Row + 1
target2_.Cells(lRow, 1).Value = "R" & i
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
sa(i).PutIndizedValues ThisWorkbook.Sheets("Mikrostörungen")
sa(i).RemoveAverages
Next i
End Sub
Der Klassenmodulcode:

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()
Dim lRow As Long, n As Long
Dim values As Range, averages As Range
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))

'Geh die Liste ab
For lRow = 2 To values.Rows.Count
'Wenn der Zeitwert zwischen 200% und 500% vom Durchschnitt liegt
If values(lRow, 1).Value >= averages(lRow, 1).Value * 2 And values(lRow, 1).Value 

End With
End Sub
Public Sub PutIndizedValues(ByRef TargetSheet As Worksheet)
Dim lRow As Long, i As Long
Dim values As Variant
With sh
For i = LBound(indizes_) To UBound(indizes_)
values = .Range(.Cells(indizes_(i), 1), .Cells(indizes_(i), 14)).Value
lRow = TargetSheet.Cells(TargetSheet.Rows.Count, 1).End(xlUp).Row + 1
With TargetSheet
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(lRow, 1), .Cells(lRow, 14)).Value = values
End With
Next i
End With
End Sub
Public Sub RemoveAverages()
sh.Cells(1, 15).EntireColumn.Delete
End Sub
Im Modulcode sieht man das zweite Worksheet für die Variable target2_.
Im Klassenmodulcode gibt es diesen Part

'Geh die Liste ab
For lRow = 2 To values.Rows.Count
'Wenn der Zeitwert zwischen 200% und 500% vom Durchschnitt liegt
If values(lRow, 1).Value >= averages(lRow, 1).Value * 2 And values(lRow, 1).Value 
ReDim Preserve indizes_(n)
indizes_(n) = lRow

n = n + 1
End If
Next lRow
Das habe ich schon angepasst, aber jetzt benötige ich dazu noch, dass wenn er über 500% und unter 1000% liegt, er es in das andere Worksheet target2_ genauso schreibt wie er es hier in target_ macht.
Leider verstehe ich diesen Part mit
  ReDim Preserve indizes_(n)
indizes_(n) = lRow
wirklich null. :(
Wie baue ich das zweite If da mit ein?
Danke und freundliche Grüße

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: frage doch direkt Peter(silie)
12.02.2018 09:42:26
Luschi
owT.
Hallo,
12.02.2018 10:12:38
Peter(silie)
indizes_ ist lediglich ein Array welches immer wieder neudimensioniert wird und
die Zeilen enthählt wo die Average Kriterien erfüllt wurden.
Ändere folgende Sachen:
Im Modul ExecuteAverage:
Option Explicit
Private sa(1 To 5) As New SheetAverage
Public Sub Stoerungen()
PutAboveAverageIntoSheet "Mikrostörungen", 2, 5
PutAboveAverageIntoSheet "Störungen", 5, 10, 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)
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("Mikrostörungen")
If RemoveAvrg Then sa(i).RemoveAverages
Next i
End Sub
Im Klassenmodul SheetAverage:
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_ 
Zur Erklärung:
Du übergibst nun den Tabellennamen wo die Daten rein sollen an PutAboveAverageIntoSheet,
sowie zwei Faktoren und einen Boolean Wert der aussagt ob die Hilfsspalte mit
den Average Werten gelöscht werden soll(dieser ist standard mäßig auf False gesetzt).
Der erste Faktor ist die Untergrenze
Der zweite Faktor ist die Obergrenze
im Klassenmodul wird dann der Average wert einaml mal Faktor1 genommen und
einmal mal Faktor2 also:
WENN (Zellwert >= Average * Faktor1) UND (Zellwert
Anzeige
AW: Hallo,
12.02.2018 10:56:58
Burak
"Argument ist nicht optional" gleich zu Beginn des Makros
AW: Hallo,
12.02.2018 11:12:59
Peter(silie)
dann hast du hier:
Private Sub PutAboveAverageIntoSheet(ByVal TargetName As String, _
Faktor1 As Long, Faktor2 As Long, _
Optional ByVal RemoveAvrg As Boolean = False)
oder hier:
Public Sub CreateIndizes(ByVal factor1 As Long, factor2 As Long)
oder hier:
    PutAboveAverageIntoSheet "Mikrostörungen", 2, 5
PutAboveAverageIntoSheet "Störungen", 5, 10, True
was falsch gemacht.
Zeig mir mal bitte wie dein Code jetzt aussieht.
Anzeige
AW: Hallo,
12.02.2018 11:16:35
Burak
Modulcode:
Option Explicit
Private sa(1 To 5) As New SheetAverage
Public Sub Stoerungen()
PutAboveAverageIntoSheet "Mikrostörungen", 2, 5
PutAboveAverageIntoSheet "Störungen", 5, 10, 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)
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("Mikrostörungen")
If RemoveAvrg Then sa(i).RemoveAverages
Next i
End Sub
Klassencode:
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_ 

Anzeige
AW: Hallo,
12.02.2018 11:20:10
Burak
ach ich habe das PutAboveAverage-Makro als Start-Makro genommen, nicht das Stoerungen-Makro :D
AW: Hallo,
12.02.2018 11:23:05
Burak
nur bei Störungen kriege ich nur die Linienbezeichnung aber keinen Eintrag, wo lege ich denn die Grenzen fest?
AW: Einträge im falschen Blatt
12.02.2018 11:48:24
Burak
Also im ersten Teil läuft alles Korrekt,Linienbezeichnungen und Einträge im Tabellenblatt Mikrostörungen, so wie es sein soll.
Im zweiten Teil, schreibt er zwar die Linienbezeichnungen in das Tabellenblatt Störungen, aber die Einträge hängt er bei dem Tabellenblatt Mikrostörungen unten an. o.o
AW: Fehler gefunden, Topic close, o.w.T
12.02.2018 12:03:36
Burak
Wo war denn der Fehler?
12.02.2018 13:28:02
Peter(silie)
Würde mich interessieren :)

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige