Makro optimieren

Forumthread: Makro optimieren

Makro optimieren

28.05.2008 11:07:00

alifa

Hallo liebe VBA Programmierer,
habe mir ein Macro für Permutationen gebastelt, doch irgendwie werden Werte von vorherigen Anwendungen übernommen und ausgewiesen. Wie werde ich die los? Gruß, alifa
Option Explicit
' Beispiel : Rekursive Permutation.
Dim strPermutation As String
Dim strZeichen As String
Dim intArray_Pos() As Integer
Dim intArray_Pos_Zeiger As Integer
Dim strErgebnis() As String
Dim lngCount As Long
Sub Uebergab() 'Fehler!!
Dim Kombination As String, i&, z%
Kombination = "12345"
Cells.ClearContents
Call Rekursive_Permutation(Kombination)
For i = 1 To lngCount
Cells(z + 1, 1) = strErgebnis(i)
z = z + 1
Next
End Sub

Sub Rekursive_Permutation(strUebergabe As String)
strZeichen = strUebergabe
intArray_Pos_Zeiger = -1
ReDim intArray_Pos(Len(strZeichen) - 1)
Call Permutation(0)
End Sub


Private Sub Permutation(intX As Integer)
Dim i As Integer
intArray_Pos_Zeiger = intArray_Pos_Zeiger + 1
intArray_Pos(intX) = intArray_Pos_Zeiger
If intArray_Pos_Zeiger = Len(strZeichen) Then
strPermutation = ""
For i = 0 To UBound(intArray_Pos)
strPermutation = strPermutation & _
Mid$(strZeichen, intArray_Pos(i), 1)
Next i
lngCount = lngCount + 1
ReDim Preserve strErgebnis(lngCount)
strErgebnis(lngCount) = strPermutation
Else
For i = 0 To Len(strZeichen) - 1
If intArray_Pos(i) = 0 Then Call Permutation(i)
Next i
End If
intArray_Pos_Zeiger = intArray_Pos_Zeiger - 1
intArray_Pos(intX) = 0
End Sub

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro optimieren

28.05.2008 14:51:12

fcs
AW: Makro optimieren

29.05.2008 21:38:39

alifa
OT: Es fehlt noch dein Kommentar...

30.05.2008 14:15:41

Luc:-?
Noch offen?

30.05.2008 14:17:00

Luc:-?

AW: Makro optimieren

28.05.2008 14:51:12

fcs

Hallo Alifa,
a einige der Variablen allgemein für das Modul deklariert sind, bleiben ihre Werte ihre Werte ggf. auch nach Ablauf eines Makrodurchlaufs erhalten.
Diese Variablen muss du zurücksetzen in der Sub Übergabe. Außer dem muss dann noch eine Redim Anweisung angepasst werden. Ich hab die Zeilen markiert.
Gruß
Franz


Option Explicit
' Beispiel : Rekursive Permutation.
Dim strPermutation As String
Dim strZeichen As String
Dim intArray_Pos() As Integer
Dim intArray_Pos_Zeiger As Integer
Dim strErgebnis() As String
Dim lngCount As Long
Sub Uebergab() 'Fehler!!
Dim Kombination As String, i&, z%
strPermutation = ""       '##
ReDim strErgebnis(1 To 1) '##
lngCount = 0              '##
Kombination = "123"
Cells.ClearContents
Call Rekursive_Permutation(Kombination)
For i = 1 To lngCount
Cells(z + 1, 1) = strErgebnis(i)
z = z + 1
Next
End Sub
Sub Rekursive_Permutation(strUebergabe As String)
strZeichen = strUebergabe
intArray_Pos_Zeiger = -1
ReDim intArray_Pos(Len(strZeichen) - 1)
Call Permutation(0)
End Sub
Private Sub Permutation(intX As Integer)
Dim i As Integer
intArray_Pos_Zeiger = intArray_Pos_Zeiger + 1
intArray_Pos(intX) = intArray_Pos_Zeiger
If intArray_Pos_Zeiger = Len(strZeichen) Then
strPermutation = ""
For i = 0 To UBound(intArray_Pos)
strPermutation = strPermutation & _
Mid$(strZeichen, intArray_Pos(i), 1)
Next i
lngCount = lngCount + 1
ReDim Preserve strErgebnis(1 To lngCount) '###
strErgebnis(lngCount) = strPermutation
Else
For i = 0 To Len(strZeichen) - 1
If intArray_Pos(i) = 0 Then Call Permutation(i)
Next i
End If
intArray_Pos_Zeiger = intArray_Pos_Zeiger - 1
intArray_Pos(intX) = 0
End Sub

AW: Makro optimieren

29.05.2008 21:38:39

alifa

Hallo,
Danke für die Hilfe. Das ist das Problem
'Addiere zu 12345678 eine Umstellung der gleichen acht Ziffern, um das kleinste
'mögliche Ergebnis zu erhalten, das aus acht geraden Ziffern besteht.


Sub Zahlsp12()
Dim a%, b%, c%, d%, e%, f%, g%, h%, m%, n%, p%, q%, r%, s%, v%, w%, z%
Dim t!, zs&, zv&
t = Timer
For a = 1 To 7
For b = 1 To 8
For c = 1 To 8
For d = 1 To 8
For e = 1 To 8
For f = 1 To 8
For g = 1 To 8
For h = 1 To 8
For m = 2 To 8
For n = 2 To 8
For p = 2 To 8
For q = 2 To 8
For r = 2 To 8
For s = 2 To 8
For v = 2 To 8
For w = 2 To 8
zs = Val(CStr(a & b & c & d & e & f & g & h))
zv = Val(CStr(m & n & p & q & r & s & v & w))
If zs + 12345678 = zv Then
If a  b And a  c And a  d And a  e And a  f And a  g And a  h _
And b  c And b  d And b  e And b  f And b  g And b  h And c  d _
And c  e And c  f And c  g And c  h And d  e And d  f And d  g _
And d  h And e  f And e  g And e  h And f  g And f  h And g  h _
And m  3 And m  5 And m  7 And n  3 And n  5 And n  7 And p  3 _
And q  5 And q  7 And p  5 And p  7 And q  3 And r  3 And r  5 _
And r  7 And s  3 And s  5 And s  7 And v  3 And v  5 And v  7 _
And w  3 And w  5 And w  7 Then
Cells(z + 1, 1) = zv
z = z + 1
End If
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
MsgBox "Fertig in " & Timer - t & " Sek"
End Sub

OT: Es fehlt noch dein Kommentar...

30.05.2008 14:15:41

Luc:-?

...zu dieser Lösung, Alifa!
Gruß Luc :-?

Noch offen?

30.05.2008 14:17:00

Luc:-?

:-?

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro optimieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread