Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1592to1596
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1592to1596
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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
    Anzeige
    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

    Anzeige
    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

    Anzeige
    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
    Anzeige
    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
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige