AW: Austiegsbedingungen schaffen...
08.05.2009 16:14:13
Hoof
Sooo, hier nun also meine Umsetzung und die Probleme die ich noch habe: =)
Option Explicit
Sub AlleKombinationen()
Dim Ergebnis As Single
Dim Zwischenergebnis As Single
Dim Z1 As Single
Dim Z2 As Single
Dim Z3 As Single
Dim z4 As Single
Dim z5 As Single
Dim z6 As Single
Dim z7 As Single
Dim z8 As Single
Dim z9 As Single
Dim z10 As Single
Dim z11 As Single
Dim z12 As Single
Dim z13 As Single
Dim z14 As Single
Dim z15 As Single
Dim z16 As Single
Dim arr(1 To 16)
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
'Application.ScreenUpdating = False
For z16 = 0 To 0.4 Step 0.1
arr(1) = z16
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(1) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z15 = 0 To 0.4 Step 0.1
arr(2) = z15
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(2) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z14 = 0 To 0.4 Step 0.1
arr(3) = z14
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(3) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z13 = 0 To 0.4 Step 0.1
arr(4) = z13
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(4) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z12 = 0 To 0.4 Step 0.1
arr(5) = z12
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(5) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z11 = 0 To 0.4 Step 0.1
arr(6) = z11
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(6) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z10 = 0 To 0.4 Step 0.1
arr(7) = z10
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(7) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z9 = 0 To 0.4 Step 0.1
arr(8) = z9
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(8) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z8 = 0 To 0.4 Step 0.1
arr(9) = z8
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(9) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z7 = 0 To 0.4 Step 0.1
arr(10) = z7
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(10) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z6 = 0 To 0.4 Step 0.1
arr(11) = z6
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(11) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z5 = 0 To 0.4 Step 0.1
arr(12) = z5
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(12) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For z4 = 0 To 0.4 Step 0.1
arr(13) = z4
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(13) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For Z3 = 0 To 0.4 Step 0.1
arr(14) = Z3
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(14) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For Z2 = 0 To 0.4 Step 0.1
arr(15) = Z2
Select Case WorksheetFunction.Sum(arr)
Case Is > 1.06:
arr(15) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
For Z1 = 0 To 0.4 Step 0.1
arr(16) = Z1
Select Case WorksheetFunction.Sum( _
arr)
Case Is > 1.06:
arr(16) = 0
Exit For
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
End Select
Sheets("Tabelle2").Select
Range("B3") = Z1
Range("B4") = Z2
Range("B5") = Z3
Range("B6") = z4
Range("B7") = z5
Range("B8") = z6
Range("B9") = z7
Range("B10") = z8
Range("B11") = z9
Range("B12") = z10
Range("B13") = z11
Range("B14") = z12
Range("B15") = z13
Range("B16") = z14
Range("B17") = z15
Range("B18") = z16
Zwischenergebnis = Cells(23, 2)
Ergebnis = Cells(32, 2)
If Zwischenergebnis > Ergebnis Then
Range("B23").Select
Selection.Copy
Range("B32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
_
:=False, Transpose:=False
Range("A3:B18").Select
Selection.Copy
Range("C32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
_
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub
Damit ich selbst weiterbasteln kann, wäre es super wenn du mir noch einmal erklärst was genau durch
Case Is > 0.96:
myDic(Join(arr, " +")) = 0
passiert!
Als Feedback zum jetzigen Code: Er variiert die ersten 3 Zellen bis max. 0,3 (?), läuft diese immer wieder durch und kombiniert dazu immer eine der weiteren zellen mit 0,1 gewicht, variiert diese aber leider nicht mehr...
Nochmals vielen Dank, bin begeistert über die schnelle Hilfe!
PS: Meine nächste Reaktion wird erst am Montag kommen.