Dreieckszahlen - speziell
25.07.2010 14:37:49
Erich
Hallo Erhard,
das könnten die Lösungen sein - je nachdem, wie man "untereinander geschrieben" interpretiert -
rechts- oder linksbündig:
| | E | F | G | H | I | J | K | L |
| 1 | xx=0: | 1 | 6 | 6 | | | | |
| 2 | | 45 | 36 | 55 | | | | |
| 3 | | 861 | 231 | 561 | | | | |
| 4 | | 5151 | 8001 | 5151 | | | | |
| 5 | | | | | | | | |
| 6 | xx>0: | 1 | 1 | 3 | 6 | 6 | 6 | 6 |
| 7 | | 36 | 36 | 36 | 15 | 45 | 45 | 55 |
| 8 | | 105 | 325 | 325 | 105 | 435 | 465 | 595 |
| 9 | | 3003 | 1653 | 3655 | 6555 | 6555 | 6555 | 6555 |
In Spalten A:D eines Tabellenblatts stehen die 1-, 2-, 3- und 4-stelligen Dreieckszahlen.
Hier der Code:
Option Explicit
Sub Dreiecke()
Dim k1 As Integer, k2 As Integer, k3 As Integer, k4 As Integer
Dim x1 As Integer, x2 As Integer, x3 As Integer, x4 As Integer
Dim ii As Long, jj As Long, mm As Long, nn As Long
Dim t1 As Long, t2 As Long, t3 As Long, t4 As Long
Dim ss As Long, xx As Long
ss = 0
xx = 5 ' 0 oder >5
For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
k1 = Cells(ii, 1)
For jj = 1 To Cells(Rows.Count, 2).End(xlUp).Row
k2 = Cells(jj, 2)
If Right(k2, 1) "0" Then
For mm = 1 To Cells(Rows.Count, 3).End(xlUp).Row
k3 = Cells(mm, 3)
If Right(k3, 1) "0" Then
For nn = 1 To Cells(Rows.Count, 4).End(xlUp).Row
k4 = Cells(nn, 4)
If Right(k4, 1) "0" Then
If xx = 0 Then
x1 = Right(k4, 1)
x2 = 10 * Right(k3, 1) + Mid(k4, 3, 1)
x3 = 100 * Right(k2, 1) + 10 * Mid(k3, 2, 1) + Mid(k4, 2, 1)
x4 = 1000 * k1 + 100 * Left(k2, 1) + 10 * Left(k3, 1) + Left(k4, 1)
Else
x1 = Left(k4, 1)
x2 = 10 * Left(k3, 1) + Mid(k4, 2, 1)
x3 = 100 * Left(k2, 1) + 10 * Mid(k3, 2, 1) + Mid(k4, 3, 1)
x4 = 1000 * k1 + 100 * Right(k2, 1) + 10 * Right(k3, 1) + Right(k4, 1)
End If
For t1 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If x1 = Cells(t1, 1) Then
For t2 = 1 To Cells(Rows.Count, 2).End(xlUp).Row
If x2 = Cells(t2, 2) Then
For t3 = 1 To Cells(Rows.Count, 3).End(xlUp).Row
If x3 = Cells(t3, 3) Then
For t4 = 1 To Cells(Rows.Count, 4).End(xlUp).Row
If x4 = Cells(t4, 4) Then
ss = ss + 1
Cells(1 + xx, ss + 5) = k1
Cells(2 + xx, ss + 5) = k2
Cells(3 + xx, ss + 5) = k3
Cells(4 + xx, ss + 5) = k4
End If
Next t4
End If
Next t3
End If
Next t2
End If
Next t1
End If
Next nn
End If
Next mm
End If
Next jj
Next ii
End Sub
Das xx dient nur dazu, dzwischen den beiden Interpretationen zu wählen.
Und hier die Spielmappe dazu: https://www.herber.de/bbs/user/70746.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort