Thema Datum  Von Nutzer Rating
Antwort
29.09.2017 00:35:04 Radler
Solved
29.09.2017 16:19:09 Mackie
NotSolved
29.09.2017 21:58:57 Radler
NotSolved
29.09.2017 22:06:43 Mackie
NotSolved
01.10.2017 17:04:27 Gast9419
NotSolved
01.10.2017 18:36:30 Radler
NotSolved
01.10.2017 23:06:32 Ben
NotSolved
02.10.2017 03:08:24 Radler
NotSolved
Rot Aufgabe mit VBA lösen
02.10.2017 09:52:02 Gast93350
NotSolved
02.10.2017 12:50:01 Radler.
NotSolved
02.10.2017 15:35:57 Gast54592
NotSolved
03.10.2017 06:52:49 Radler
NotSolved
03.10.2017 15:35:51 Gast94472
NotSolved
03.10.2017 21:47:29 Radler
NotSolved
04.10.2017 10:35:52 Radler
NotSolved
06.10.2017 14:58:20 Gast38955
NotSolved
06.10.2017 21:32:15 Radler
NotSolved
08.10.2017 15:44:57 Gast58396
NotSolved
08.10.2017 20:10:13 Radler
NotSolved
09.10.2017 09:38:56 Gast65905
NotSolved
09.10.2017 14:59:02 Radler
NotSolved
11.10.2017 16:06:12 Gast22845
NotSolved
12.10.2017 07:47:21 Radler
NotSolved
12.10.2017 18:56:09 Gast73494
NotSolved

Ansicht des Beitrags:
Von:
Gast93350
Datum:
02.10.2017 09:52:02
Views:
807
Rating: Antwort:
  Ja
Thema:
Aufgabe mit VBA lösen

Moin!

Also das hier wäre eine Lösung:

                  1  
    2       3        
          4          
5     6       7      
  8                 9
      1 0     1 1    
                  1 2
1 3     1 4          
            1 5      
1 6     1 7       1 8

Bitte mal prüfen, sollte aber mit deinen Vorgaben übereinstimmen. Der Code dazu wie unten aus. Einfach in ein Modul kopieren. Die Ausgabe erfolgt in das aktuelle Blatt. Da ich keine Lust hast in die Tiefen der Mathematik zu steigen und über x Gleichsungssysteme eine Lösung zu suchen, habe ich mich auf "BruteForce" beschränkt und dabei noch ein paar Schranken eingebaut, um nicht durch alle Möglichkeiten zu gehen.

VG

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
Option Explicit
 
Dim zielmatrix()
Dim summen()
Dim zahl As Long
 
 
Sub matrix()
Dim zeile As Long
Dim spalte As Long
Dim start
Dim ende
Application.ScreenUpdating = False
 
start = Now
ReDim zielmatrix(1 To 11, 1 To 11)
 
For spalte = 1 To 11
    zielmatrix(11, spalte) = "x"
Next spalte
 
summen = Array(0, 7, 17, 2, 7, 2, 15, 4, 13, 1, 3, 19)
 
For zahl = 18 To 1 Step -1
    If zahl >= 10 Then
        If zahl_eintragen(Right(zahl, 1), 2) Then
           
        Else
            zahl_zurück
        End If
    Else
        If zahl_eintragen(zahl, 1) Then
 
        Else
            zahl_zurück
        End If
    End If
Next zahl
 
If zahl > 0 Then
    MsgBox "keine Lösung gefunden"
    Exit Sub
End If
 
For zeile = 1 To 10
    For spalte = 1 To 11
        If zielmatrix(zeile, spalte) = "x" Then zielmatrix(zeile, spalte) = ""
    Next spalte
Next zeile
 
ActiveSheet.Range("B1:L11") = zielmatrix
ende = Now
MsgBox "fertig!" & Chr(10) & "Dauer: " & Format(ende - start, "ss") & " Sekunden"
Application.ScreenUpdating = True
 
End Sub
 
Function zahl_eintragen(zahl1 As Long, stellen As Long) As Boolean
Dim fertig As Boolean
Dim zeile As Long
Dim spalte As Long
Dim klein As Long
Dim i As Long
Dim anzx As Long
 
fertig = False
klein = False
For zeile = 10 To 1 Step -1
    For spalte = 11 To 1 Step -1
        If zielmatrix(zeile, spalte) = "" Then
         
            If zeile = 9 And zahl = 18 Then
                MsgBox "Fehler", , "Fehler"
                End
            End If
             
            If ((zeile - 1) * 11 + spalte) < (2 * zahl) Then
                klein = True
            End If
             
            If klein = False And zeile < 10 Then
                anzx = 0
                For i = 1 To 11
                    If zielmatrix(zeile + 1, i) = "x" Then anzx = anzx + 1
                Next
                 
                If anzx = 11 Then klein = True
            End If
             
            If zahl1 <= summen(spalte) And zielmatrix(zeile + 1, spalte) = "x" And klein = False Then
                If stellen = 2 Then
                    If spalte > 1 Then
                        If summen(spalte - 1) > 0 And zielmatrix(zeile + 1, spalte - 1) = "x" Then
                            zahl_eintragen = True
                            summen(spalte) = summen(spalte) - zahl1
                            summen(spalte - 1) = summen(spalte - 1) - 1
                            zielmatrix(zeile, spalte) = zahl1
                            zielmatrix(zeile, spalte - 1) = 1
                            If spalte > 2 Then zielmatrix(zeile, spalte - 2) = "x"
                            fertig = True
                        Else
                            zielmatrix(zeile, spalte) = "x"
                        End If
                    Else
                        zahl_eintragen = False
                        fertig = True
                    End If
                Else
                    zahl_eintragen = True
                    summen(spalte) = summen(spalte) - zahl1
                    zielmatrix(zeile, spalte) = zahl1
                    If spalte > 1 Then zielmatrix(zeile, spalte - 1) = "x"
                    fertig = True
                End If
            Else
                zielmatrix(zeile, spalte) = "x"
            End If
        End If
        If fertig = True Then Exit For
    Next spalte
    If fertig = True Then Exit For
Next zeile
 
End Function
Sub zahl_zurück()
Dim fertig As Boolean
Dim erster As Boolean
Dim zeile As Long
Dim spalte As Long
Dim neuzahl As Long
 
erster = False
fertig = False
For zeile = 1 To 10
    For spalte = 1 To 11
        If zielmatrix(zeile, spalte) <> "" Then
 
            If erster = False Then
                If IsNumeric(zielmatrix(zeile, spalte)) Then
                    summen(spalte) = summen(spalte) + zielmatrix(zeile, spalte)
                    neuzahl = zielmatrix(zeile, spalte)
                    zielmatrix(zeile, spalte) = "x"
                    If spalte < 11 Then
                        If IsNumeric(zielmatrix(zeile, spalte + 1)) Then
                            summen(spalte + 1) = summen(spalte + 1) + zielmatrix(zeile, spalte + 1)
                            neuzahl = 10 + CLng(zielmatrix(zeile, spalte + 1))
                            zielmatrix(zeile, spalte + 1) = "x"
                        End If
                    End If
                    fertig = True
                Else
                    zielmatrix(zeile, spalte) = ""
                End If
                 
                erster = True
            Else
             
                If IsNumeric(zielmatrix(zeile, spalte)) Then
                    summen(spalte) = summen(spalte) + zielmatrix(zeile, spalte)
                    neuzahl = zielmatrix(zeile, spalte)
                    zielmatrix(zeile, spalte) = "x"
                        If spalte < 11 Then
                            If IsNumeric(zielmatrix(zeile, spalte + 1)) Then
                                summen(spalte + 1) = summen(spalte + 1) + zielmatrix(zeile, spalte + 1)
                                neuzahl = 10 + CLng(zielmatrix(zeile, spalte + 1))
                                zielmatrix(zeile, spalte + 1) = "x"
                                 
                            End If
                        End If
  
                    fertig = True
                Else
                    zielmatrix(zeile, spalte) = ""
                End If
            End If
        End If
         
        If fertig = True Then Exit For
    Next spalte
    If fertig = True Then Exit For
Next zeile
 
zahl = neuzahl + 1
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
29.09.2017 00:35:04 Radler
Solved
29.09.2017 16:19:09 Mackie
NotSolved
29.09.2017 21:58:57 Radler
NotSolved
29.09.2017 22:06:43 Mackie
NotSolved
01.10.2017 17:04:27 Gast9419
NotSolved
01.10.2017 18:36:30 Radler
NotSolved
01.10.2017 23:06:32 Ben
NotSolved
02.10.2017 03:08:24 Radler
NotSolved
Rot Aufgabe mit VBA lösen
02.10.2017 09:52:02 Gast93350
NotSolved
02.10.2017 12:50:01 Radler.
NotSolved
02.10.2017 15:35:57 Gast54592
NotSolved
03.10.2017 06:52:49 Radler
NotSolved
03.10.2017 15:35:51 Gast94472
NotSolved
03.10.2017 21:47:29 Radler
NotSolved
04.10.2017 10:35:52 Radler
NotSolved
06.10.2017 14:58:20 Gast38955
NotSolved
06.10.2017 21:32:15 Radler
NotSolved
08.10.2017 15:44:57 Gast58396
NotSolved
08.10.2017 20:10:13 Radler
NotSolved
09.10.2017 09:38:56 Gast65905
NotSolved
09.10.2017 14:59:02 Radler
NotSolved
11.10.2017 16:06:12 Gast22845
NotSolved
12.10.2017 07:47:21 Radler
NotSolved
12.10.2017 18:56:09 Gast73494
NotSolved