Hola!! ;D a ver si me podeiss ayudar, la duda es:
Tengo esto para generar palabras aleatorias:
Pero quiero que esas palabras no se puedan repetir... y ya esta, asi de simple... :laugh:
(No os asusteis que esta en sucio ;))
Private Sub Aleatory_Comb(ByRef CharList() As String, ByVal iDigits As Integer, ByVal iNumber As Long)
Dim sWord As String
Dim x As Long
Dim y As Long
For y = 1 To iNumber
For x = 1 To iDigits
Randomize
sWord = sWord + CharList((Rnd * (UBound(CharList()) - 1) + 1))
Next
MsgBox sWord: sWord = ""
Next
End Sub
Private Sub Form_Load()
Dim Matriz() As String
Matriz = Split("a,b,c,d,e,f,g,h,i,j,k,l,,m,ñ,o,p,q,r,s,t,u,v,w,x,y,z", ",")
Call Aleatory_Comb(Matriz, 5, 7)
End Sub
Gracias!!
Porque no guardas en un array las palabras generadas y cada vez que generas una nueva si es repetida no la agregas ni la devuelves si es nueva la devuelves?.-
Pense eso ya, pero si genero 5000 palabras y cada una que genere tengo que buscarla en el array se demoraria mucho la cosa, no crees?? :silbar:
Salu2 y gracias!
Es que es bien simple si no lo guardas no sabes si la palabra la generaste o no, en algún momento vas a tener que guardarlas y en algún momento compararlas. De todas formas no se en que pc estes programando pero no veo mejor eficiencia que tener un arraylist y preguntarle si ya tiene el elemento guardado.
Si quieres mas eficiencia haces tu el metodo de busqueda por ejemplo un algoritmo de busqueda binaria y cuando asignas siempre asignas de forma ordenada las palabras así mejoraras la eficiencia, de todas forma prueba lo que te sugiero no creo que tengas una demora de mas de 2ms en devolver si la palabra esta o no en el arraylist con 5k registros.-
Hace tiempo hice lo mismo pero con numeros de n cifras... Y pes, yo no veo otra forma de no generar las mismas palabras que comparandolo con las otras palabras generadas... Al menos no uno mas eficiente... Si lo logras seria muy buen aporte :xD
Si las palabras fueran todas las que puedes formar con X letras, o determinadas secuencias quizás se pudiera pensar en algún algoritmo con programación dinámica, o backtraking pero así palabras al azar de cualquier largo, sin guardarlas no veo como y de todas formas con pd o backtrak vas a necesitar guardar cosas.
Opino igual si encuentran una forma sin guardar seria un buen aporte, estare atento al tema :).-
.
Yo uso este Modulo de Clase para esto Cls_StrCmb.cls, aqui les dejo un Ejemplo practico SIN FORM.
Estableces el proceso inicial en Sub Main OJO!¡.
Cls_StrCmb.cls
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandesido //
' // o achicado, si es en base a este codigo es requerido //
' // el agradacimiento al autor. //
' /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem Eventos.
Event StrOuput(ByRef Str_Text As String, ByRef Cancel As Boolean)
Rem Declaracion (Variables).
Private Priv_String As String
Rem Propiedades.
Public Property Get String_() As String
String_ = Priv_String
End Property
Public Property Let String_(Str_String As String)
Priv_String = Str_String
End Property
Rem Procesos/funciones.
Public Function Start_(Optional StrToProc As String) As Boolean
If Len(StrToProc) Then String_ = StrToProc
Call CombinateString(Priv_String)
End Function
Rem funciones/Procesos
Private Sub CombinateString(ByRef Str_String As String, Optional ByRef str_Fix As String, Optional ByRef Cancel As Boolean)
Dim Lng_LenStr As Long
Dim Lng_LenStrIndex As Long
If Cancel Then Exit Sub
Lng_LenStr = Strings.Len(Str_String)
If Lng_LenStr <> 1 Then
For Lng_LenStrIndex = 1 To Lng_LenStr
Call CombinateString(Strings.Left$(Str_String, Lng_LenStrIndex - 1) & Strings.Mid$(Str_String, Lng_LenStrIndex + 1), str_Fix & Strings.Mid$(Str_String, Lng_LenStrIndex, 1), Cancel)
Next
Else
RaiseEvent StrOuput(str_Fix & Str_String, Cancel)
End If
End Sub
Cls_Main.cls
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandesido //
' // o achicado, si es en base a este codigo es requerido //
' // el agradacimiento al autor. //
' /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem Eventos.
Public WithEvents ClsStrCmb As Cls_StrCmb
Rem Declaraciones.
Private CantCombinateString As Long
Rem procesos/Funciones
Private Sub ClsStrCmb_StrOuput(ByRef Str_Text As String, ByRef Cancel As Boolean)
CantCombinateString = CantCombinateString + 1
Debug.Print Str_Text
DoEvents
End Sub
Public Property Get MaxConbinaciones() As Long
MaxConbinaciones = CantCombinateString
End Property
Private Sub Class_Initialize()
Set ClsStrCmb = New Cls_StrCmb
End Sub
Private Sub Class_Terminate()
Set ClsStrCmb = Nothing
End Sub
Mod_Main.bas
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandesido //
' // o achicado, si es en base a este codigo es requerido //
' // el agradacimiento al autor. //
' /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem Procesos/funciones
Sub MAIN()
Dim Cls_NewMainProc As New Cls_Main
Const Const_StrtoProc As String = "BlackZeroX"
With Cls_NewMainProc
With .ClsStrCmb
' // .String_ = Const_StrtoProc
Call .Start_(Const_StrtoProc)
End With
Debug.Print "Max Combinaciones {"; .ClsStrCmb.String_; "} son de"; .MaxConbinaciones
End With
End Sub
Dulce Infierno Lunar!¡.
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este Codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandesido //
' // o achicado, si es en base a este codigo es requerido //
' // el agradacimiento al autor. //
' /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem Procesos/funciones
Sub MAIN()
Dim Cls_NewMainProc As New Cls_Main
Const Const_StrtoProc As String = "BlackZeroX"
With Cls_NewMainProc
With .ClsStrCmb
' // .String_ = Const_StrtoProc
Call .Start_(Const_StrtoProc)
End With
Debug.Print "Max Combinaciones {"; .ClsStrCmb.String_; "} son de"; .MaxConbinaciones
End With
End Sub
Pero si no me equivoco esto unicamente te muestra la cantidad de combinaciones posibles, ¿no? :huh:
Gracias y Salu2! ;)
No, te muestra en el debuger las combinaciones posibles de el texto insertado, pero mejor LEE BIEN EL CODIGO FUENTE COMPLETO!¡,
El procesador real esta en Cls_StrCmb y este salta un evento en cada combinación el cual es accinado en Cls_Main el cual es el contener de los evento y el objecto Cls_StrCmb del cual todo empiesa en Mod_Main
Pero mejor correlo y abre el Debuger o Inmediato del IDE de VB6 ( Control + G )
Dulce Infierno Lunar!¡.
Ok Gracias... ;D
Private Sub ClsStrCmb_StrOuput(ByRef Str_Text As String, ByRef Cancel As Boolean)
CantCombinateString = CantCombinateString + 1
Debug.Print Str_Text
DoEvents
End Sub
Dulce Infierno Lunar!¡.
Concretamente para lo que queria hacer se me ocurrio esto:
Option Explicit
Private Sub Aleatory_Comb(ByRef CharList() As String, ByVal iDigits As Integer, ByVal iNumber As Long)
Dim sWord As String
Dim lTotalChar As Long
Dim x As Long
Dim y As Long
Dim Col As Collection
Set Col = New Collection
lTotalChar = UBound(CharList())
If iNumber > (lTotalChar) ^ iDigits Then Exit Sub
On Error Resume Next
Do While y < iNumber
For x = 1 To iDigits
Randomize
sWord = sWord + CharList((Rnd * (lTotalChar - 1)) + 1)
Next
Col.Add sWord, sWord
If Err.Number = 0 Then
Debug.Print sWord
y = y + 1
Else
Debug.Print "Palabra duplicada : "; sWord 'Esta linea es solo para que veais que la detecta
Err.Clear
End If
sWord = vbNullString
Loop
Set Col = Nothing
End Sub
Private Sub Form_Load()
Dim Matriz() As String
Matriz = Split("a,b,c", ",") ' Solo pongo 3 letras para que se repitan =)
Call Aleatory_Comb(Matriz, 5, 7)
End Sub
Funcionar funciona... ;)
Salu2! :)