Zeichenkette mit Sequenzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub TesteKetten() Dim a, b, c, d, e, f, g, h, i, j, k, s For a = 1 To 9 For b = 1 To 9 For c = 1 To 9 For d = 1 To 9 For e = 1 To 9 For f = 1 To 9 For g = 1 To 9 For h = 1 To 9 For i = 1 To 9 For j = 1 To 9 For k = 1 To 9 s = CStr(a & b & c & d & e & f & g & h & i & j & k) If Verschieden(Replace(s, 0, "")) Then 'jetzt folgt die Bedingung: s hat 2 Sequenzen(sequ1 und sequ2) 'deren Summen s1=21 und s2=15 sind If Sequenzen(s, 2, 21, 15) Then ' Sequenzen ist die Funktion, die noch 'erfunden weden soll... 's=00984000762 oder s=98400007620 oder s=05970000438.... 'es gibt also mehrere Lösungen. Mit zusätzlichen Bedingunen(die hier nicht 'von Bedeutung sind) grenze ich die Ergebnisse ein MsgBox a End Sub 'alle Ziffern unterschiedlich.Beispiel:Verschieden(Cstr(a1 & a2 & a3)) Function Verschieden(ByVal Zahl As String, Optional i As Integer) As Boolean For i = Len(Zahl) To 1 Step -1 If Len(Zahl) - Len(Replace(Zahl, Mid$(Zahl, i, 1), "")) 1 Then Exit For Next Verschieden = i = 0 End Function

…liegen, was du hier nicht thematisieren willst, Alifa;
bisher bin ich nämlich davon ausgegangen, dass das HptProblem die Bildung einer QuersummenFolge über eine (hier durch 0) unterbrochene Ziffernfolge ist. Dabei wäre der Ersatz von 0 durch "" kontraproduktiv, denn die Ziffernfolge wäre dann ja nicht mehr unterbrochen.
Vielleicht käme es ja wirklich erstmal nur darauf an, was man statt deiner geplanten Fkt Sequenzen auch mit meiner UDF DiSum, der Lösung von XlFmln nach Splitten der Ziffernfolge in selbständige Einzelteile (Sequenzen) oder den dir bereits im Okt2009 bzw Jan2014 aufgezeigten Möglichkeiten bewältigen kann.
Die DiSum-Fml kann übrigens auch so aussehen:

	A	B	C
1	Ziffernfolge	SeqzQSumVorgabe	Bestätigung
2	00109870650	1,24,11	WAHR
3	00984000762	21,15	WAHR
4	0078240007521	21,15	WAHR
5	C2[:C4]:=B2=WECHSELN(DiSum(GLÄTTEN(WECHSELN(A2;0;" ")));" ";",")

Du scheinst es umgekehrt versuchen und direkt nach der VorgabeSequenz in der unterbrochenen Ziffernfolge suchen zu wollen, was ich für ein doch sehr (bzw zu) spezifisches EinsatzGebiet einer solchen Fkt halte. Es ist idR immer günstiger, allgemeinere Lösungsmöglichkeiten zu nutzen als einen solchen „insularen“ Aufwand zu treiben (vor allem, wenn man das nicht selber schafft!)… ;-)
Luc :-?

Hi Erhard,
probier mal den folgenden Code. Er ist recht kurz, dafür aber umso langsamer:


Option Explicit
Sub Sequ()
Dim arQ, aa As Long, zz As Double, arS, ii As Long, jj As Long, ss As Long
Dim ee As Long, arT() As Boolean, arZ(0 To 9) As Boolean
arQ = Array(1, 14, 11)           ' Beispiel: Quersummen für 3 Sequenzen
aa = UBound(arQ)
For zz = 1 To 99999999999#
Application.StatusBar = zz & " / " & ee
DoEvents
arS = Split(Application.Trim(Replace(zz, "0", " ")))
If aa = UBound(arS) Then
ReDim arT(aa)
For ii = 0 To aa
Erase arZ
For jj = 1 To Len(arS(ii))                ' in Sequ. keine doppelte Ziffer
If arZ(Mid(arS(ii), jj, 1)) Then Exit For Else arZ(Mid(arS(ii), jj, 1)) = True
Next jj
If jj  aa Then
For jj = 1 To aa                          ' alle Vorgabe-Quersummen gefunden?
arT(0) = arT(0) And arT(jj)
Next jj
If arT(0) Then
ee = ee + 1                            ' Ausgabezeile
Cells(ee, 1) = Time
Cells(ee, 2) = zz
Cells(ee, 3).Resize(, aa + 1) = arS
End If
End If
End If
Next zz
Application.StatusBar = False
End Sub

Kommen da die Ergebnisse raus, die du haben wolltest?
Ein Tipp: Bei Vorgabe der Quersummen mit Array(1, 14, 11) ist 1029059 der erste Treffer,
also kannst du die zz-Schleife statt bei 1 besser bei z. B. 1029050 starten lassen.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Ein schönes Wochenende allerseits!

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread