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
Hallo Michael,
(23.04.2014, 21:02)michel34497 schrieb: [ -> ]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
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
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.
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
Hallo Michael,
(24.04.2014, 20:40)michel34497 schrieb: [ -> ]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.
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
hi Michael, jetzt mal im ernst: in welchem anderen forum hast du deine anfrage "CommandButton Farbe ändern" noch gepostet..?
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