Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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


Anzeige
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


Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige