weitere Spalten

Daniel · 2005-10-06T15:47:47+00:00

Hi... Ich habe mir überlegt das ich mit ner For Next Schleife doch auch noch andere Spalten prüfen lassen kann. Aber irgendwie haut das net hin. Ich muss aber für jede Spalte andere feste Grenzen festlegen. Mit dem Code (Vielen dank an die Experten von hier) funktioniert das bei einer Spalte. Es soll aber auch Spalte 7,8,11,12,13,14,15,16 durch prüfen. Wie muss ich den Code dann ändern. Für jede Spalte gibt es andere Ober und Untergrenzen. Vielen Dank Daniel Private Sub Bereinigung_Click() Const OBERGRENZE As Long = 150000 Const UNTERGRENZE As Long = 0 Const AB_ZEILE As Integer = 6 Const IN_SPALTE As Integer = 7 Dim rng As Range Dim c As Range Dim lngAvg As Long With Worksheets("Daten") Set rng = .Cells(Rows.Count, IN_SPALTE).End(xlUp) If rng.Row > AB_ZEILE Then Set rng = .Range(.Cells(AB_ZEILE, IN_SPALTE), .Cells(Rows.Count, IN_SPALTE).End(xlUp)) For Each c In rng.Cells lngAvg = WorksheetFunction.Average(rng) If c OBERGRENZE Then c = lngAvg Next End If Set rng = Nothing End With End Sub

Hallo Daniel,
die bisherigen Codes verwendeten für die Durchschnittsbildung auch die "schlechten" Werte. Darauf habe ich dich aufmerksam machen wollen: Die bisherigen Codes rechnen nach meiner Ansicht Unfug aus.
Aus deiner letzten Frage kann ich nur entnehmen, dass du das inzwischen auch nicht mehr willst...
Ich hatte dir geschrieben:
"Ich vermute, du möchtest in diesen beiden Zellen den Durchschnitt aller "vernünftigen" Werte, also derer, die zwischen Unter- und Obergranze liegen,"
Hier der (gewachsene, daher "suboptimale") Code dafür.
(Anmerkung: Der Durchschnitt wird auch in leere oder mit Text gefüllte Zellen eingetragen, die innerhalb des benutzten Bereichs einer Spalte liegen.)


Private Sub Bereinigung_Click()
Const AB_ZEILE As Integer = 6
Const AnzSp = 9
Dim rng As Range
Dim c As Range
Dim lngAvg As Long
Dim ii As Integer, SpW(1 To AnzSp, 1 To 3) As Long
Dim anzOK As Integer, arrOK
ii = ii + 1: SpW(ii, 1) = 6:  SpW(ii, 2) = 0: SpW(ii, 3) = 150000
ii = ii + 1: SpW(ii, 1) = 7:  SpW(ii, 2) = 0: SpW(ii, 3) = 150000
ii = ii + 1: SpW(ii, 1) = 8:  SpW(ii, 2) = 0: SpW(ii, 3) = 160000
ii = ii + 1: SpW(ii, 1) = 11: SpW(ii, 2) = 0: SpW(ii, 3) = 170000
ii = ii + 1: SpW(ii, 1) = 12: SpW(ii, 2) = 0: SpW(ii, 3) = 180000
ii = ii + 1: SpW(ii, 1) = 13: SpW(ii, 2) = 0: SpW(ii, 3) = 190000
ii = ii + 1: SpW(ii, 1) = 14: SpW(ii, 2) = 0: SpW(ii, 3) = 100000
ii = ii + 1: SpW(ii, 1) = 15: SpW(ii, 2) = 0: SpW(ii, 3) = 110000
ii = ii + 1: SpW(ii, 1) = 16: SpW(ii, 2) = 0: SpW(ii, 3) = 120000
With Worksheets("Daten")
For ii = 1 To AnzSp
If .Cells(Rows.Count, SpW(ii, 1)).End(xlUp).Row > AB_ZEILE Then
Set rng = .Range(.Cells(AB_ZEILE, SpW(ii, 1)), _
.Cells(Rows.Count, SpW(ii, 1)).End(xlUp))
'        ------------ "gute" Werte zählen
anzOK = 0
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
anzOK = anzOK + 1
End If
Next c
If anzOK = 0 Then
MsgBox "Kein zulässiger Wert in Spalte" & Str(ii)
Else
'           --------- Array mit "guten" Werten anlegen
ReDim arrOK(1 To anzOK)
anzOK = 0
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
anzOK = anzOK + 1
arrOK(anzOK) = c
End If
Next c
'           --------- Durchschnitt der "guten" Werte berechnen
lngAvg = WorksheetFunction.Average(arrOK)
'           --------- Durchschnitt in die "schlechten" Zellen eintragen
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
Else
c = lngAvg
End If
Next c
End If
End If
Next ii
Set rng = Nothing
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Hallo Daniel,
hier eine neue Version. Die verträgt es auch, wenn du weniger als AnzSp Spalten auswerten willst:


Private Sub Bereinigung_Click()
Const AB_ZEILE As Integer = 6
Const AnzSp = 9
Dim rng As Range
Dim c As Range
Dim lngAvg As Integer
Dim ii As Integer, SpW(1 To AnzSp, 1 To 3) As Long
Dim anzOK As Integer, arrOK() As Integer
'  ii = ii + 1: SpW(ii, 1) = 6:  SpW(ii, 2) = 0: SpW(ii, 3) = 150000
ii = ii + 1: SpW(ii, 1) = 7:  SpW(ii, 2) = 0: SpW(ii, 3) = 150000
ii = ii + 1: SpW(ii, 1) = 8:  SpW(ii, 2) = 0: SpW(ii, 3) = 160000
ii = ii + 1: SpW(ii, 1) = 11: SpW(ii, 2) = 0: SpW(ii, 3) = 170000
ii = ii + 1: SpW(ii, 1) = 12: SpW(ii, 2) = 0: SpW(ii, 3) = 180000
ii = ii + 1: SpW(ii, 1) = 13: SpW(ii, 2) = 0: SpW(ii, 3) = 190000
ii = ii + 1: SpW(ii, 1) = 14: SpW(ii, 2) = 0: SpW(ii, 3) = 100000
ii = ii + 1: SpW(ii, 1) = 15: SpW(ii, 2) = 0: SpW(ii, 3) = 110000
ii = ii + 1: SpW(ii, 1) = 16: SpW(ii, 2) = 0: SpW(ii, 3) = 120000
With Worksheets("Daten")
For ii = 1 To AnzSp
'     --------------- "gute" Werte zählen
If SpW(ii, 1) < 1 Or SpW(ii, 1) >= Rows.Count Then GoTo NXT
If .Cells(Rows.Count, SpW(ii, 1)).End(xlUp).Row <= AB_ZEILE Then _
GoTo NXT
Set rng = .Range(.Cells(AB_ZEILE, SpW(ii, 1)), _
.Cells(Rows.Count, SpW(ii, 1)).End(xlUp))
'     ------------ "gute" Werte zählen
anzOK = 0
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
anzOK = anzOK + 1
End If
Next c
If anzOK = 0 Then _
MsgBox "Kein zulässiger Wert in Spalte" & Str(SpW(ii, 1)): GoTo NXT
'     --------- Array mit "guten" Werten anlegen
ReDim arrOK(1 To anzOK)
anzOK = 0
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
anzOK = anzOK + 1
arrOK(anzOK) = c
End If
Next c
'     --------- Durchschnitt der "guten" Werte berechnen
lngAvg = WorksheetFunction.Average(arrOK)
'     --------- Durchschnitt in die "schlechten" Zellen eintragen
For Each c In rng.Cells
If Not IsEmpty(c) And SpW(ii, 2) <= c And c <= SpW(ii, 3) Then
Else
c = lngAvg
End If
Next c
NXT:
Next ii
End With
Set rng = Nothing
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Forumthread: weitere Spalten

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

weitere Spalten

Forumthread: weitere Spalten

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread