Berechnung nach Rangliste

[michel34497]

Hallo Leute!
Wie schon angekündigt werde ich die Datei euch nochmals Zuverfügung stellen.
Meine frage im alten Forum war ob mann den Code verbessern kann.
Ich bin aber so damit zufrieden da er ja so Funktioniert wie ich es will.

Hinter den Namen (ab A8-A25)wird in den Spalten Spiel1 - 6 Werte eingegeben.
Dadurch ändert sich die Rangliste in Spalte N.
Betätigt ihr nun die Schaltfläche :92:, berechnet der Code den Betrag den jeder bezahlen muss.
Ihr werdet sehen wenn es eine doppel Wwertung gibt was dann Passiert.
Genau so können auch Namen hinzugefügt oder gelöscht werden, beim löschen nur darauf achten das in der Spalte H und M die einträge auch gelöscht werden.
Erstmal Viel Spass beim Testen :19:
Bei Fragen einfach melden :30:



Dateiupload bitte im Forum! So geht es: Klick mich!

mfg
Michael

[Steffl]

Hallo Michael,

Meine frage im alten Forum war ob mann den Code verbessern kann.
Ich bin aber so damit zufrieden da er ja so Funktioniert wie ich es will.

Ich hatte damals den Code schon überarbeitet, leider ist dann das Forum abgeschaltet worden.

Du könntest auf das Selektieren verzichten, einige Variablentypen verwendest Du meinerachtens falsch, machst Berechnungen mit einem String und benutzt Goto :s

Hier mal mein Code

PHP-Code:

Sub prcMichael()

   Dim rngPlatz As Range
   Dim dblAufschlag As Double
   Dim lngRang As Long
   Dim strFirstAddress As String
   
   Application.EnableEvents = False
   With Worksheets("Spiele")
      'die Anzahl der Ränge
      lngRang = .Cells(8, 19).Value
      Do
         'suchen der Platzierung
         Set rngPlatz = .Range("N9:N25").Find(what:=lngRang, lookat:=xlWhole, LookIn:=xlValues)
         If Not rngPlatz Is Nothing Then
            'wenn es einen Treffer gibt, merke die Adresse
            strFirstAddress = rngPlatz.Address
            Do
               'und schreibe den Betrag in die Spalte links davon
               rngPlatz.Offset(0, -1).Value = lngRang / 10 + dblAufschlag
               'suchen ob der Platz nochmals vorhanden ist
               Set rngPlatz = .Range("N9:N25").FindNext(rngPlatz)
            'wiederhole es so oft, bis der erste Treffer wieder gefunden wird
            Loop While rngPlatz.Address <> strFirstAddress
            lngRang = lngRang - 1
         Else
            'falls der Platz nicht gefunden wird, erhöhe den Aufschlaug
            dblAufschlag = dblAufschlag + 0.1
            lngRang = lngRang - 1
         End If
      'wiederhole die Schleife bis der Platz "0" erreicht ist
      Loop Until lngRang = 0
   End With
   Application.EnableEvents = True

End Sub 


[michel34497]

Hallo Stefan!

Vielen Dank für deine Antwort!
Habe deine antwort in dem alten Forum nicht mehr sehen könne.
Habe grade mal den Code eingebaut und getestet, sieht sehr gut aus. :28:
Werde es aber noch ausführlicher testen und dann nochmal Rückmeldung geben.

Danke nochmals

mfg

Michael

[Käpt'n Blaubär]

Hallo Stefan, Hallo Michael,

da ist offensichtlich noch ein bischen mehr fehlerhaft, als nur ein bischen "Select"

https://www.dropbox.com/s/66ew4jlhi3b9a7c/Michael1.jpg

https://www.dropbox.com/s/y8rp3b9l76l84le/Michael2.jpg

[Steffl]

Hallo Peter,

die Meldung mit der Kompabilitätsprüfung habe ich auch erhalten, die andere aber nicht. Warten wir mal ab, was Michael dazu sagt.

[michel34497]

Hallo Peter und Stefan,

die erste Meldung bekomme ich auch immer wenn ich die Datei Abspeichere.
Habe immer gedacht es liege immer an ecxel .xls oder xlm, hab aber keine Ahnumg warum diese Meldung kommt.
Ich nehme sie einfach hin. Die zweite Meldung habe ich bis jetzt noch nicht bekommen.
Habt ihr vieleicht eine Ahnung woran das liegen kann?

Ach so der Code funktioniert einwandfrei. Ich habe mir meinen Code einfach aus meheren sachen zusammen gebastelt. Bin halb ANFÄNGER und lehrne ständig dazu. Vieleicht schaffe ich es ja auch mal auf den höheren level und dann anderen zu helfen.
Vielen Dank nochmals dafür.

mfg

Michael

[Steffl]

Hallo Michael,

Bin halb ANFÄNGER und lehrne ständig dazu. Vieleicht schaffe ich es ja auch mal auf den höheren level und dann anderen zu helfen.

sehr viel lernen kannst Du, indem Du in den Foren mitliest, bei den Fragen versuchst, selber eine Lösung zu erarbeiten und danach vergleichst, was haben die anderen Antworter so gebracht. Ein paar Sachen könntest Du auch auf Online-Excel finden.

[michel34497]

Hallo Stefan!

Danke für den Tip!
Versuche alles zu beherzigen, doch manchmal sieht man den Wald vor Augen Nicht!
Ich bin grade wieder an so einer sache dran und komme einfach nicht weiter, Ich weiß das wir das schon einmal gemacht haben.
Das ist aber dann ein anderes Thema.

mfg

Michael

[Jockel]

hi Michael, jetzt mal im ernst: in welchem anderen forum hast du deine anfrage "CommandButton Farbe ändern" noch gepostet..?

[michel34497]

Hallo Jörg!
Wenn ich das wüsste hätte ich nicht die Frage an Hajo gestellt. In den Forum wo ich noch angemeldet bin habe ich danach gesucht und zu den Thema CommandButton nichts von mir gefunden! Das Thema dort war ListBox Farbig darstellen.
Sorry ich weiß nicht was er meint.

Mit freunlichen Gruß

Michael