Code kürzen

Forumthread: Code kürzen

Code kürzen

19.11.2017 18:57:22

Frank

Hallo an alle
Ich versuche es mal zu erklären.
Ich vergleiche 2 Werte miteinander. Von Zeile 6 bis 35 vergleiche ich mit Spalte 11 bis 40.
Wenn der Wert größer als 75 ist gibt es 1 Punkt, wenn mehr als 150 Punkte sind gibt es 2 Punkte oder bei 225 dann 3 Punkte usw wenn Wert negativ ist, dann halt -1, -2 Punkte.
Meine Frage ist, kann man den Teil bei "Select case" auch Kürzer schreiben? oder völlig anders?


Sub Punkte_bestimmen ()
With ActiveSheet
For Zeile = 11 To .Cells(Rows.Count, 3).End(xlUp).Row
For Spalte = 6 To .Cells(7, Columns.Count).End(xlToLeft).Column
If .Cells(Zeile - x, Spalte).Value  .Cells(Zeile, Spalte - y).Value Then
Select Case (.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y). _
Value)
Case 0 To 74
.Cells(Zeile, Spalte).Value = 0
Case -74 To 0
.Cells(Zeile, Spalte).Value = 0
Case 75 To 149
.Cells(Zeile, Spalte).Value = 1
Case -149 To -75
.Cells(Zeile, Spalte).Value = -1
Case 150 To 224
.Cells(Zeile, Spalte).Value = 2
Case -224 To -150
.Cells(Zeile, Spalte).Value = -2
Case 225 To 299
.Cells(Zeile, Spalte).Value = 3
Case -299 To -225
.Cells(Zeile, Spalte).Value = -3
Case 300 To 374
.Cells(Zeile, Spalte).Value = 4
Case -374 To -300
.Cells(Zeile, Spalte).Value = -4
Case 375 To 449
.Cells(Zeile, Spalte).Value = 5
Case -449 To -375
.Cells(Zeile, Spalte).Value = -5
Case 450 To 524
.Cells(Zeile, Spalte).Value = 6
Case -524 To -450
.Cells(Zeile, Spalte).Value = -6
Case Is > 525
.Cells(Zeile, Spalte).Value = 7
Case Is

danke für eure Hilfe
Frank

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code kürzen

19.11.2017 19:20:12

Sepp
Sorry, falscher Code!

19.11.2017 19:34:31

Sepp
AW: Sorry, falscher Code!

20.11.2017 10:43:50

Frank
AW: Code kürzen

19.11.2017 19:29:16

Daniel
AW: Code kürzen

19.11.2017 19:39:59

onur
AW: Code kürzen

19.11.2017 20:00:06

Gerd

AW: Code kürzen

19.11.2017 19:20:12

Sepp

Hallo Frank,

Sub Punkte_bestimmen()
Dim dblTemp As Double
With ActiveSheet
  For Zeile = 11 To .Cells(Rows.Count, 3).End(xlUp).Row
    For Spalte = 6 To .Cells(7, Columns.Count).End(xlToLeft).Column
      If .Cells(Zeile - x, Spalte).Value <> .Cells(Zeile, Spalte - y).Value Then
        .Cells(Zeile, Spalte).Value = _
          Application.RoundDown(.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y).Value, 0)
        y = y + 1
      Else
        .Cells(Zeile, Spalte).Value = 0
      End If
    Next Spalte
    x = x + 1
    y = 2
  Next Zeile
End With
End Sub

Gruß Sepp

Sorry, falscher Code!

19.11.2017 19:34:31

Sepp

Hallo Frank,
da ist beim Kopieren etwas unterschlagen worden ;-)

Sub Punkte_bestimmen()
Dim dblTemp As Double
With ActiveSheet
  For Zeile = 11 To .Cells(Rows.Count, 3).End(xlUp).Row
    For Spalte = 6 To .Cells(7, Columns.Count).End(xlToLeft).Column
      If .Cells(Zeile - x, Spalte).Value <> .Cells(Zeile, Spalte - y).Value Then
        .Cells(Zeile, Spalte).Value = _
          Application.RoundDown((.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y).Value) / 75, 0)
        y = y + 1
      Else
        .Cells(Zeile, Spalte).Value = 0
      End If
    Next Spalte
    x = x + 1
    y = 2
  Next Zeile
End With
End Sub

Gruß Sepp

AW: Sorry, falscher Code!

20.11.2017 10:43:50

Frank

Hallo Sepp und auch die anderen,
danke für eure Lösungen,
auf durch 75 Teilen und dann abrunden bin ich überhaupt nicht gekommen
danke dafür
Grüße Frank

AW: Code kürzen

19.11.2017 19:29:16

Daniel

Hi
da die Punktewertung von einem vielfachen von 75 abhängt, kannst du doch einfach den Wert durch 75 teilen und abrunden:
.Cells(Zeile, Spalte).Value = Worksheetfunction.RoundDown((.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y).Value) / 75, 0)
oder nutze die Möglichkeit zur Ganzzahldivision in VBA. Hierzu verwendet man den Backslash als Divisionszeichen, dann kann das Abrunden entfallen:
.Cells(Zeile, Spalte).Value = (.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y).Value) / 75
vielleicht kannst du ja den Code komplett entfallen lassen und eine entsprechende Formel in die Zellen schreiben (hier dann nur mit Abrunden) =Abrunden((Zelle1-Zelle2)/75;0)
Gruß Daniel

AW: Code kürzen

19.11.2017 19:39:59

onur

Poste mal die Datei. man kann bestimmt eine Formel dafür schreiben.

AW: Code kürzen

19.11.2017 20:00:06

Gerd

Hallo Frank,
ungetestet mit Obergrenze.

Sub Punkte_bestimmen()
Dim dblTemp As Double, Zeile As Long, Spalte As Long, x As Long, y As Long
With ActiveSheet
For Zeile = 11 To .Cells(Rows.Count, 3).End(xlUp).Row
For Spalte = 6 To .Cells(7, Columns.Count).End(xlToLeft).Column
dblTemp = (.Cells(Zeile - x, Spalte).Value - .Cells(Zeile, Spalte - y).Value) / 75
.Cells(Zeile, Spalte).Value = _
Sgn(dblTemp) * Application.Min(7, Application.RoundDown(dblTemp, 0))
y = y + Abs(CBool(dblTemp))
Next Spalte
x = x + 1
y = 2
Next Zeile
End With
End Sub

Gruß Gerd

Beliebteste Forumthreads (12 Monate)

Forumthread: Code kürzen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread