Buenas noches o tardes:
Tengo un programa que hace calculos de combinaciones alfanumericas sin repeticiones hecho en un principio en vb6.0 y lo pase a vb.net 2010 (se los paso para el que le pueda servir), el problema radica que si el tamaño de grupo es igual al numero
de la lista del grupo, solo calcula la prmera linea y se sale, ejemplo: el grupo es de solo 2 y la lista es "1,2", en el listbox, solo saca:
1,2
y le falta el 2,1. en la funcion CreaGrupos esta el problema, pero, cada vez que lo suprimo o le cambio un valor, me manda error.
Public Class Form1
Public TamGrupos As Integer = 2 ' Tamaño de los grupos
Public ListaDeNumeros As String = "1,2,3,4" ' lista de numeros separados por comas
Public Parar As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Parar = 1
End Sub
Private Function CalculaTotal(ByVal TamGrupos As Integer, ByVal MaximoValor As Integer) As Long
Dim C1 As Double
Dim C2 As Double
Dim F As Double
C1 = 1
C2 = 1
For F = 1 To TamGrupos
C1 = C1 * F
Next F
For F = MaximoValor To (MaximoValor - (TamGrupos - 1)) Step -1
C2 = C2 * F
Next F
CalculaTotal = C2 / C1
End Function
Private Sub CreaGrupos(ByVal TamGrupos As Integer, ByVal TopeOListaDeNumerosSeparadosPorComas As String, ByRef ListaDevuelta() As String)
' Busqueda de combinaciones.
' Dados los numeros de TopeOListaDeNumerosSeparadosPorComas,
' saca todos los grupos no repetidos de "TamGrupos" numeros
' y los devuelve en la matriz Lista()
' Por repetido se entiende que "1,2,3" es igual que "1,3,2", igual que "2,1,3", etc...
' Ejm: 1,2,3,4 de 2 en 2 = 6 combinaciones
' 1,2 - 1,3 - 1,4 - 2,3 - 2,4 - 3,4
' Opcionalmente, en lugar de una lista de números puedes poner un solo número.
' En ese caso la listadenumeros seran los números desde el 1 hasta el que pongas.
Dim F As Double
Dim Linea As String
Dim Num As Double
Dim Total As Double
Dim Ap() As Double
Dim MaximoValor As Long
Dim MatrizDeNumeros() As String
MatrizDeNumeros = Split(TopeOListaDeNumerosSeparadosPorComas, ",")
MaximoValor = UBound(MatrizDeNumeros) + 1
If MaximoValor = 1 And Val(MatrizDeNumeros(0)) > 0 Then
MaximoValor = Val(MatrizDeNumeros(0))
ReDim MatrizDeNumeros(MaximoValor - 1)
For F = 1 To MaximoValor
MatrizDeNumeros(F - 1) = F
Next F
End If
Total = CalculaTotal(TamGrupos, MaximoValor)
ReDim Ap(TamGrupos)
ReDim ListaDevuelta(Total - 1)
Dim Contador As Long
Contador = -1
Parar = 0
' Cogemos las primeras
For F = 1 To TamGrupos
Ap(F) = F
Next F
OtraVez:
'Preparo la linea con la combinacion
Linea = ""
For F = 1 To TamGrupos - 1
Linea = Linea & MatrizDeNumeros(Ap(F) - 1) & " , "
Next F
Linea = Linea & MatrizDeNumeros(Ap(TamGrupos) - 1)
' Guardo la combiancion
Contador = Contador + 1
ListaDevuelta(Contador) = Linea
'Label4.Caption = Contador + 1 ' Muestro el progreso
Application.DoEvents()
If Parar = 1 Then GoTo Fin
Num = TamGrupos + 1
Repetir1:
Num = Num - 1 ' Cogemos la apuesta(num) (en principio la ultima)
'La aumentamos...
Ap(Num) = Ap(Num) + 1
' si es mayor de la cuenta...
If Ap(Num) > (MaximoValor - (TamGrupos - Num)) Then
' si es la ap(1) se acaba
If Num = 1 Then GoTo Fin
' ...aumentamos la anterior
GoTo Repetir1
End If
' Si no llega a su limite se mira si alguna ha llegado
' a su maximo
' Si NUM no apunta a la ultima AP() es que
' alguna ap() ha llegado a su maximo
' entonces reiniciamos todas las siguientes...
If Num <> TamGrupos Then
For F = Num + 1 To TamGrupos
'....dandoles el valor de la anterior + 1...
Ap(F) = Ap(F - 1) + 1
Next F
End If
' ... Y se da por valida
GoTo OtraVez
Fin:
Parar = 1
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Parar = 0 Then Parar = 1 : Exit Sub
Dim Matriz() As String = Nothing ' matriz donde recibiremos la lista
CreaGrupos(TamGrupos, ListaDeNumeros, Matriz)
'Aqui manipulas la matriz como quieras
' por ejemplo pasandola a un listbox
ListBox1.Visible = False
Dim F As Long
For F = 0 To UBound(Matriz)
ListBox1.Items.Add(Matriz(F))
Next F
ListBox1.Visible = True
End Sub
End Class
De antemano, muchas gracias!!!
