Permuta
Como hago para pasarles lo que tengo en un text1.text a la función de permuta de números, y como hago para que si le doy 6 números a combinar, dichas combinaciones me las muestre en grupos de 3, que no se repitan..
Respuesta de aromman
1
Podes por ejemplo llamarlo así
MSGBOX Permutar(text1.text)
MSGBOX Permutar(text1.text)
Ok esa parte la entendí.. declare una variable como string y a esa variable le asigne lo que tenia text1.text, ahora el problema me da cuando necesito tratar cada combinación posible una por una.. osea quiero trabajar 123, y luego 132 y así sucesivamente...
Disculpame pensé que había utilizado vbCrLf (salto de linea) para separar cada permuta así que te adapte el código y te lo envío completo, espero que ahora si te sirva, saludos
///////////////////////////
Private Sub Form_Load()
Dim s As String
s = Permutar("123")
Dim vP() As String
' llamamos a la funcion split que corta en trozos
' el string que nos devuelve la funcion permuta
' fijate que el " " es el caracter que separa a cada
' Permuta
vP = Split(s, " ")
' luego recorremos el vector para lo que necesitemos
Dim i As Integer
For i = 0 To UBound(vP)
MsgBox "esta es la permuta " & vP(i)
Next
End Sub
Function Permutar(s As String) As String
Dim i As Integer
Dim s2 As String
Dim sOut As String
Dox s, Len(s), sOut
Permutar = Trim(sOut)
End Function
Sub AgregarCombinacion(ByRef s As String, sNew As String)
' no agrega elementos duplicados
If InStr(1, s, sNew) = 0 Then
s = s & sNew & " "
End If
End Sub
Sub Dox(ByRef s As String, m As Integer, ByRef sOut As String)
Dim s2 As String, x As Integer
s2 = s
If m > 2 Then
For x = 1 To m
Dox s2, m - 1, sOut
s2 = Desplazar(s2, m)
Next x
Else
AgregarCombinacion sOut, s
AgregarCombinacion sOut, Desplazar(s2, m)
End If
End Sub
Function Desplazar(ByRef s As String, m As Integer) As String
If Len(s) > m Then
sStg = Left(s, Len(s) - m) & Right(s, m - 1) & Mid(s, IIf(m = 2, Len(s), m) - 1, 1)
Else
sStg = Right(s, m - 1) & Left(s, 1)
End If
Desplazar = sStg
End Function
///////////////////////////
Private Sub Form_Load()
Dim s As String
s = Permutar("123")
Dim vP() As String
' llamamos a la funcion split que corta en trozos
' el string que nos devuelve la funcion permuta
' fijate que el " " es el caracter que separa a cada
' Permuta
vP = Split(s, " ")
' luego recorremos el vector para lo que necesitemos
Dim i As Integer
For i = 0 To UBound(vP)
MsgBox "esta es la permuta " & vP(i)
Next
End Sub
Function Permutar(s As String) As String
Dim i As Integer
Dim s2 As String
Dim sOut As String
Dox s, Len(s), sOut
Permutar = Trim(sOut)
End Function
Sub AgregarCombinacion(ByRef s As String, sNew As String)
' no agrega elementos duplicados
If InStr(1, s, sNew) = 0 Then
s = s & sNew & " "
End If
End Sub
Sub Dox(ByRef s As String, m As Integer, ByRef sOut As String)
Dim s2 As String, x As Integer
s2 = s
If m > 2 Then
For x = 1 To m
Dox s2, m - 1, sOut
s2 = Desplazar(s2, m)
Next x
Else
AgregarCombinacion sOut, s
AgregarCombinacion sOut, Desplazar(s2, m)
End If
End Sub
Function Desplazar(ByRef s As String, m As Integer) As String
If Len(s) > m Then
sStg = Left(s, Len(s) - m) & Right(s, m - 1) & Mid(s, IIf(m = 2, Len(s), m) - 1, 1)
Else
sStg = Right(s, m - 1) & Left(s, 1)
End If
Desplazar = sStg
End Function
Trate y trate pero no pude hacer que me dijera cada uno de los elementos del array...
Acá te paso un código simple en base a lo que devuelve la función Permuta.
///////////////////////////
' definimos un arreglo de string
Dim vP() As String
' Llamamos a la función split que corta en trozos
' el string que nos devuelve la función permuta
' fíjate que el vbCrLf es el carácter que separa a cada
' Permuta
vP = Split(text1.txt, vbCrLf)
' luego recorremos el vector para lo que necesitemos
Dim i As Integer
For i = 0 To UBound(vP)
msbox "esta es la permuta " & vP(i)
Next
///////////////////////////
' definimos un arreglo de string
Dim vP() As String
' Llamamos a la función split que corta en trozos
' el string que nos devuelve la función permuta
' fíjate que el vbCrLf es el carácter que separa a cada
' Permuta
vP = Split(text1.txt, vbCrLf)
' luego recorremos el vector para lo que necesitemos
Dim i As Integer
For i = 0 To UBound(vP)
msbox "esta es la permuta " & vP(i)
Next
Te paso un código más copado
Agrega un modulo de clase y pegale el siguiente código y llamalo Permuta
////////////////////////////
Private oCol As Collection
Sub Permutar(s As String)
Dim i As Integer
Dim s2 As String
Dim sOut As String
Dox s, Len(s), sOut
End Sub
Function getCombinacion() As Collection
Set getCombinacion = oCol
End Function
Private Sub AgregarCombinacion(sNew As String)
' no agrega elementos duplicados
If Not Existe(sNew) Then
oCol.Add sNew, sNew
End If
End Sub
Private Function Existe(sNew As String) As Boolean
Existe = False
For Each x In oCol
If x = sNew Then
Existe = True
Exit For
End If
Next
End Function
Private Sub Dox(ByRef s As String, m As Integer, ByRef sOut As String)
Dim s2 As String, x As Integer
s2 = s
If m > 2 Then
For x = 1 To m
Dox s2, m - 1, sOut
s2 = Desplazar(s2, m)
Next x
Else
AgregarCombinacion s
AgregarCombinacion Desplazar(s2, m)
End If
End Sub
Private Function Desplazar(ByRef s As String, m As Integer) As String
If Len(s) > m Then
sStg = Left(s, Len(s) - m) & Right(s, m - 1) & Mid(s, IIf(m = 2, Len(s), m) - 1, 1)
Else
sStg = Right(s, m - 1) & Left(s, 1)
End If
Desplazar = sStg
End Function
Private Sub Class_Initialize()
Set oCol = New Collection
End Sub
Private Sub Class_Terminate()
Set oCol = Nothing
End Sub
///////////////////////
y para usarlo lo llamas asi
////////////////////////////
Private Sub Form_Load()
Dim oPermuta As New Permuta
oPermuta.Permutar ("123")
For Each x In oPermuta.getCombinacion
MsgBox "esta es la permuta " & x
Next
End Sub
////////////////////////
Agrega un modulo de clase y pegale el siguiente código y llamalo Permuta
////////////////////////////
Private oCol As Collection
Sub Permutar(s As String)
Dim i As Integer
Dim s2 As String
Dim sOut As String
Dox s, Len(s), sOut
End Sub
Function getCombinacion() As Collection
Set getCombinacion = oCol
End Function
Private Sub AgregarCombinacion(sNew As String)
' no agrega elementos duplicados
If Not Existe(sNew) Then
oCol.Add sNew, sNew
End If
End Sub
Private Function Existe(sNew As String) As Boolean
Existe = False
For Each x In oCol
If x = sNew Then
Existe = True
Exit For
End If
Next
End Function
Private Sub Dox(ByRef s As String, m As Integer, ByRef sOut As String)
Dim s2 As String, x As Integer
s2 = s
If m > 2 Then
For x = 1 To m
Dox s2, m - 1, sOut
s2 = Desplazar(s2, m)
Next x
Else
AgregarCombinacion s
AgregarCombinacion Desplazar(s2, m)
End If
End Sub
Private Function Desplazar(ByRef s As String, m As Integer) As String
If Len(s) > m Then
sStg = Left(s, Len(s) - m) & Right(s, m - 1) & Mid(s, IIf(m = 2, Len(s), m) - 1, 1)
Else
sStg = Right(s, m - 1) & Left(s, 1)
End If
Desplazar = sStg
End Function
Private Sub Class_Initialize()
Set oCol = New Collection
End Sub
Private Sub Class_Terminate()
Set oCol = Nothing
End Sub
///////////////////////
y para usarlo lo llamas asi
////////////////////////////
Private Sub Form_Load()
Dim oPermuta As New Permuta
oPermuta.Permutar ("123")
For Each x In oPermuta.getCombinacion
MsgBox "esta es la permuta " & x
Next
End Sub
////////////////////////
