Dart.

[Henrik Christensen]

Jeg håber der er en som har en ide til dette problem.

jeg har lavet et regnskab som holder øje med hvor meget jeg har tilbage,
hver gang jeg har kastet de 3 dart pile og lagt scoren sammen som så trækkes
fra udgangs punktet
som er 5001.

Normalt er en kamp på 5 sæt af 501
5001 er kun en score jeg har sat for at træne høje score og høje lukninger.
lukkes med en DOUBLE

Her er så mit spørgsmål :?

jeg har en celle som fortæller hvad der er tilbage.
når den celle`s værdi er på 170 og ned efter skal jeg have den til at
fortælle mig hvilke luknings muligheder der er

eventuelt poppe op med en msgbox

170 lukkes med Tribble 20 ,Tribble 20 bullseye.
169 kan ikke lukkes
168 kan ikke lukkes
167 lukkes med Tribble 20 ,Tribble 19,Double 20
166 kan ikke lukkes
165 kan ikke lukkes
164 lukkes med Tribble 20 ,Tribble 18,Double 20
163 kan ikke lukkes
162 kan ikke lukkes
161 lukkes med Tribble 20 ,Tribble 17,Double 20
160 lukkes med Tribble 20 ,Tribble 20,Double 20
også videre ned til der er 2 point tilbage

som kun kan lukkes på Double 1.

når man kommer under 150 er der indtil flere varianter af lukninger

den måde jeg har forsøgt at lave det på er at en celle referere til den
celle hvor rest scoren er

eksempel =hvis(a1=170 ;1)
så kan jeg ud fra det punkt få den til at sige sand eller falsk hvis a1 er
170

dette er gjort for hver rest score osv. indtil 2

umidbart kan jeg ikke lige se en nemmere måde at gøre det på.

alle idéer bliver taget seriøse.

mvh. Henrik

[Flemming Dahl]

Hej Henrik

Her er et enkelt forslag.

Jeg kan huske (gammel haj), at der fantes en oversigt over de mest brugte
lukninger af topspillerne, jeg kunne forestille mig, at alle disse
lukningsmetoder ligger i "Ark2", og du så kunne bruge LOPSALG til at hente
en mulig lukning med.

Der findes jo et hav af lukningsmåder for f.eks. 52, og her vil du vel have
forslaget 20, dbl 16 og ikke "trib10, 2, dbl 10". Hvilket er årsagen til, at
jeg kun vil indtaste de lukninger, som normalt bruges, dvs. 1 lukning pr.
rest værdi.

Mvh
Flemming

Henrik Christensen <Henr...@email.dk> skrev i en
nyhedsmeddelelse:9b0nju$4um$1...@news.cybercity.dk...

[Leo Heuser]

Hej Henrik

Jeg har lavet lidt kode, du kan hygge dig med :-)

Kopier og indsæt følgende program i et almindeligt modul:

_____________________________

Option Explicit
Option Base 1
Private NextRow As Long

Sub DartCombinations(Total As Long, StartCombCell As Range)
'leo.h...@get2net.dk, April 2001

'Combinations (1=single, 2=double, 3=triple)
'1 dart| 2 darts | 3 darts
'-------------------------------------------------
'2 | 2 2 2 | 2 2 2 | 2 2 | 2
' | 1 2 3 | 1 1 1 | 2 2 | 3
' | | 1 2 3 | 2 3 | 3

' X X X X X X Check for duplicates

Dim PointFigures As Variant
Dim Counter As Long, Counter1 As Long, Counter2 As Long, Counter3 As Long
Dim Dummy As Variant
Dim NewRest As Long
Dim SaveRest As Long, SaveRest1 As Long
Dim Flag1 As String, Flag2 As String, Flag3 As String
Dim GetComb As Boolean, GetComb1 As Boolean, GetComb2 As Boolean
Dim GetComb3 As Boolean, GetComb4 As Boolean, GetComb5 As Boolean
Dim GetComb6 As Boolean
Dim ColComb As Boolean

PointFigures = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, _
13, 14, 15, 16, 17, 18, 19, 20, 25)
NextRow = 0

'One dart, Double
For Counter = 1 To UBound(PointFigures)
If Total = PointFigures(Counter) * 2 Then
Flag1 = "Double " & PointFigures(Counter)
If Flag1 = "Double 25" Then Flag1 = "Bull's-eye"
ValueFound StartCombCell, 1, Flag1, Flag2, Flag3
Exit For
End If
Next Counter

'Two darts, Double-single, double-double, double-triple
For Counter = 1 To UBound(PointFigures)
NewRest = Total - PointFigures(Counter) * 2
If NewRest <= 0 Then Exit For
Flag1 = "Double " & PointFigures(Counter)
If Flag1 = "Double 25" Then Flag1 = "Bull's-eye"
SaveRest = NewRest
For Counter1 = 1 To 3
If Counter1 = 3 Then
Dummy = UBound(PointFigures) - 1
Else
Dummy = UBound(PointFigures)
End If
For Counter2 = 1 To Dummy
NewRest = SaveRest - PointFigures(Counter2) * Counter1
If NewRest < 0 Then
Exit For
ElseIf NewRest = 0 Then
Select Case Counter1
Case 1
Dummy = ""
Case 2
Dummy = "Double "
Case 3
Dummy = "Triple "
End Select
Flag2 = Dummy & PointFigures(Counter2)
If Flag2 = "Double 25" Then Flag2 = "Bull's-eye"
GetComb = False
If Counter1 = 2 Then
GetComb = NewCombination(StartCombCell, Flag2, _
Flag1, Flag3)
End If
ValueFound StartCombCell, GetComb, _
Flag1, Flag2, Flag3
Exit For
End If
Next Counter2
Next Counter1
Next Counter

'Three darts, Double-single-single, double-single-double
'double-single-triple
For Counter = 1 To UBound(PointFigures)
NewRest = Total - PointFigures(Counter) * 2
If NewRest <= 0 Then Exit For
Flag1 = "Double " & PointFigures(Counter)
If Flag1 = "Double 25" Then Flag1 = "Bull's-eye"
SaveRest = NewRest
For Counter1 = 1 To UBound(PointFigures)
NewRest = SaveRest - PointFigures(Counter1)
If NewRest <= 0 Then Exit For
Flag2 = PointFigures(Counter1)
SaveRest1 = NewRest
For Counter2 = 1 To 3
If Counter2 = 3 Then
Dummy = UBound(PointFigures) - 1
Else
Dummy = UBound(PointFigures)
End If
For Counter3 = 1 To Dummy
NewRest = SaveRest1 - PointFigures(Counter3) * Counter2
If NewRest < 0 Then
Exit For
ElseIf NewRest = 0 Then
Select Case Counter2
Case 1
Dummy = ""
Case 2
Dummy = "Double "
Case 3
Dummy = "Triple "
End Select
Flag3 = Dummy & PointFigures(Counter3)
If Flag3 = "Double 25" Then Flag3 = "Bull's-eye"
GetComb = False: GetComb1 = False
Select Case Counter2
Case 1
GetComb = NewCombination(StartCombCell, _
Flag1, Flag3, Flag2)
Case 2
GetComb1 = NewCombination(StartCombCell, _
Flag3, Flag2, Flag1)
End Select
ColComb = GetComb + GetComb1
ValueFound StartCombCell, ColComb, _
Flag1, Flag2, Flag3
Exit For
End If
Next Counter3
Next Counter2
Next Counter1
Next Counter

'Three darts, Double-double-double, double-double-triple
For Counter = 1 To UBound(PointFigures)
NewRest = Total - PointFigures(Counter) * 2
If NewRest <= 0 Then Exit For
Flag1 = "Double " & PointFigures(Counter)
If Flag1 = "Double 25" Then Flag1 = "Bull's-eye"
SaveRest = NewRest
For Counter1 = 1 To UBound(PointFigures)
NewRest = SaveRest - PointFigures(Counter1) * 2
If NewRest <= 0 Then Exit For
Flag2 = "Double " & PointFigures(Counter1)
If Flag2 = "Double 25" Then Flag2 = "Bull's-eye"
SaveRest1 = NewRest
For Counter2 = 2 To 3
If Counter2 = 3 Then
Dummy = UBound(PointFigures) - 1
Else
Dummy = UBound(PointFigures)
End If
For Counter3 = 1 To Dummy
NewRest = SaveRest1 - PointFigures(Counter3) * Counter2
If NewRest < 0 Then
Exit For
ElseIf NewRest = 0 Then
Select Case Counter2
Case 2
Dummy = "Double "
Case 3
Dummy = "Triple "
End Select
Flag3 = Dummy & PointFigures(Counter3)
If Flag3 = "Double 25" Then Flag3 = "Bull's-eye"
GetComb = False: GetComb1 = False: GetComb2 = False
GetComb3 = False: GetComb4 = False: GetComb5 = False
GetComb6 = False
Select Case Counter2
Case 2
GetComb = _
NewCombination(StartCombCell, Flag1, _
Flag2, Flag3)
GetComb1 = _
NewCombination(StartCombCell, Flag1, _
Flag3, Flag2)
GetComb2 = _
NewCombination(StartCombCell, Flag3, _
Flag1, Flag2)
GetComb3 = _
NewCombination(StartCombCell, Flag2, _
Flag1, Flag3)
GetComb4 = _
NewCombination(StartCombCell, Flag2, _
Flag3, Flag1)
GetComb5 = _
NewCombination(StartCombCell, Flag3, _
Flag2, Flag1)
Case 3
GetComb6 = _
NewCombination(StartCombCell, Flag2, _
Flag1, Flag3)
End Select

ColComb = GetComb * GetComb1 * GetComb2 _
* GetComb3 * GetComb4 * GetComb5 + _
GetComb6

ValueFound StartCombCell, ColComb, _
Flag1, Flag2, Flag3
Exit For
End If
Next Counter3
Next Counter2
Next Counter1
Next Counter

'Three darts, Double-triple-triple
For Counter = 1 To UBound(PointFigures)
NewRest = Total - PointFigures(Counter) * 2
If NewRest <= 0 Then Exit For
Flag1 = "Double " & PointFigures(Counter)
If Flag1 = "Double 25" Then Flag1 = "Bull's-eye"
SaveRest = NewRest
For Counter1 = 1 To UBound(PointFigures) - 1
NewRest = SaveRest - PointFigures(Counter1) * 3
If NewRest <= 0 Then Exit For
Flag2 = "Triple " & PointFigures(Counter1)
SaveRest1 = NewRest
For Counter3 = 1 To UBound(PointFigures) - 1
NewRest = SaveRest1 - PointFigures(Counter3) * 3
If NewRest < 0 Then
Exit For
ElseIf NewRest = 0 Then
Flag3 = "Triple " & PointFigures(Counter3)
GetComb = NewCombination(StartCombCell, Flag1, _
Flag3, Flag2)
ValueFound StartCombCell, GetComb, Flag1, Flag2, Flag3
Exit For
End If
Next Counter3
Next Counter1
Next Counter
End Sub

Sub ValueFound(StartCombCell As Range, ColComb As Boolean, Flag1 As String,
Flag2 As String, Flag3 As String)

If ColComb Then
StartCombCell.Offset(NextRow, 0).Value = _
Flag1 & " " & Flag2 & " " & Flag3
NextRow = NextRow + 1
End If

End Sub

Function NewCombination(StartCombCell As Range, Flag1 As String, Flag2 As
String, Flag3 As String) As Boolean
Dim SearchRange As Range
Dim Comb As String

Set SearchRange = StartCombCell.Resize(NextRow + 1, 1)

Comb = Flag1 & " " & Flag2 & " " & Flag3

If Application.CountIf(SearchRange, Comb) = 0 Then
NewCombination = True
End If

Set SearchRange = Nothing
End Function

_________________________________

I Ark1: I A1 skrives "Points", i B1 skrives "Rest"
Højreklik på Ark1s fane og vælg "Vis programkode"
Kopier og indsæt nedenstående kode:

________________________

Private Sub Worksheet_Change(ByVal Target As Range)
Dim InputColumn As Range
Dim StartCombCell As Range
Dim CountDownCell As Range
Dim StartCell As Range
Dim StartNumber As Long
Dim PointsSoFar As Long

StartNumber = 501
Set InputColumn = ActiveSheet.Columns("A")
Set StartCell = InputColumn.Cells(2, 1) ' A2 og ned
Set CountDownCell = Target.Offset(0, 1) ' B2 og ned
Set StartCombCell = CountDownCell.Offset(0, 1) 'C? og ned

On Error GoTo Finito
If Not Intersect(Target, InputColumn) Is Nothing And Target.Cells.Count
= 1 Then
StartCombCell.EntireColumn.ClearContents
PointsSoFar = Application.Sum(Range(StartCell,
StartCell.End(xlDown)))
Application.EnableEvents = False
With CountDownCell
.Value = StartNumber - PointsSoFar
DartCombinations .Value, StartCombCell
End With
End If

Finito:
Application.EnableEvents = True
Set InputColumn = Nothing
Set StartCombCell = Nothing
Set CountDownCell = Nothing
Set StartCell = Nothing
End Sub

________________

Når du indsætter points i A2 og ned vil antal points, der er tilbage
blive vist i B2 og ned. Når resttallet når 170 og derunder, vil der i
C-kolonnen stå, hvilke kombinationer, du kan afslutte spillet med.
Hvem skulle have troet, at resttallet med flest kombinationer er 56,
og at det tilhørende antal kombinationer er 343!

Hvis der opstår problemer, er du velkommen til at komme tilbage.

Med venlig hilsen
LeoH

"Henrik Christensen" <Henr...@email.dk> skrev i en meddelelse
news:9b0nju$4um$1...@news.cybercity.dk...

[Henrik Christensen]

Jeg kigger på det
mvh Henrik

"Leo Heuser" <leo.h...@get2net.dk> skrev i en meddelelse
news:9bkm89$muh$1...@sunsite.dk...

[Finn Denis Nissen]

Hej Leo
Jeg har af nysgerrighed kørt din VBA kode til Dart, jeg er dybt imponeret og jeg forstår til fulde den respekt der er
omkring dig her i gruppen !!!!!
Man skulle tro at du selv har været med til at udvikle VBA
mvh Denis
"Leo Heuser" <leo.h...@get2net.dk> skrev i en meddelelse news:9bkm89$muh$1...@sunsite.dk...

> Hej Henrik
>
> Jeg har lavet lidt kode, du kan hygge dig med :-)
>
> Kopier og indsæt følgende program i et almindeligt modul:
>

> __klip___________________________
>

[Leo Heuser]

Tak for de pæne ord Denis.
Det varmer i de gamle knogler :-)

Med venlig hilsen
Leo

"Finn Denis Nissen" <finn...@privat.dk> skrev i en meddelelse
news:9c0kuq$lpf$1...@news.inet.tele.dk...