Entonces no es mi funcion lo que necesitas.

No se me ocurría por donde pillarlo, asi que he usado una sub recursiva muy chula que nos dejó seba123neo, con algunas modificaciones.

Aquí está la sub original:
http://foro.elhacker.net/programacion_vb/combinaciones_vb-t240009.0.html

Y esto es lo que he sacado:

Hace falta un command button y un listbox.

Option Explicit
Private Sub Command1_Click()
  Dim F As Long
  Dim F2 As Long
  Dim Matriz1() As String
  Dim Matriz2() As String
  Dim MatrizFinal() As String
  Dim Linea As String
  Dim Contador As Long
  Dim ListaElementos As String
 
  List1.Clear
 
  ListaElementos = "AA,BB,CC,15,EE,20,GG,01" ' max. 10 elementos
 
  Matriz1 = Split(ListaElementos, ",") 'separamos los elementos
  For F = 0 To UBound(Matriz1) ' creamos una linea con X numeros
    Linea = Linea & CStr(F)
  Next F
 
  ReDim Matriz2(0)
  Call Combinaciones(Linea, Matriz2) ' creamos la matriz con las combinaciones de los X numeros
 
  ReDim MatrizFinal(0)
  For F = 0 To UBound(Matriz2) - 1
    Linea = ""
    For F2 = 1 To UBound(Matriz1) + 1 ' reemplazamos los numeros por los elementos de la lista
      Linea = Linea & Matriz1(Val(Mid$(Matriz2(F), F2, 1))) & ","
    Next F2
    ReDim Preserve MatrizFinal(Contador)
    MatrizFinal(Contador) = Left(Linea, Len(Linea) - 1) 'guardamos quitando la ultima coma
    Contador = Contador + 1
  Next F
 
  ' mostramos el resultado
  MsgBox "Total " & Contador & " grupos" ' mostramos la cantidad de grupos extraidos
  For F = 0 To UBound(MatrizFinal)
    List1.AddItem MatrizFinal(F) ' y los cargamos en el listbox
  Next F
 
 
End Sub
 
Private Sub Combinaciones(Palabra As String, ByRef Matriz() As String, Optional strFixed As String)
 
    Dim i As Integer
 
    If Len(Palabra) > 1 Then
 
        For i = 1 To Len(Palabra)
 
            Combinaciones Left$(Palabra, i - 1) & Mid$(Palabra, i + 1), Matriz, strFixed & Mid$(Palabra, i, 1)
 
        Next i
 
    Else
        Matriz(UBound(Matriz)) = strFixed & Palabra
        ReDim Preserve Matriz(UBound(Matriz) + 1)
 
    End If
 
End Sub

A la sub de seba123neo solo le he añadido una matriz donde ir dejando los grupos que luego convertiremos segun nuestra necesidad.
Es mejor usar matrices porque un listbox tiene más limitaciones de capacidad.

Espero que te sirva.
Saludos

Hola Arturoro.
No tengo muy claro lo que explicas ni como te ha salido el numero 40320.
Las combinaciones sin repetición de 8 elementos en grupos de 2 creo que serian algo como 7+6+5+4+3+2+1
En tu ejemplo:
7
AA,BB
AA,CC
AA,15
AA,EE
AA,20
AA,GG
AA,01
6
BB,CC
BB,15
BB,EE
BB,20
BB,GG
BB,01
5
CC,15
CC,EE
CC,20
CC,GG
CC,01
4
15,EE
15,20
15,GG
15,01
3
EE,20
EE,GG
EE,01
2
20,GG
20,01
1
GG,01

El problema que veo es que pones grupos de 8 donde deberias poner un 2
Public TamGrupos As Integer = 8 ' Tamaño de los grupos
De modo que solo te muestra 1 grupo con los 8 elementos

Saludos

Supongo que solo te falta añadir una linea para conseguir el valor que buscas.
Algo así en esta zona:

Do While fich2.atEndOfStream <> True
  linea2=fich2.ReadLine
' Ahora mostramos la línea leída
  wscript.echo linea2
' Parseamos los campos
  campos = split(linea2,"#")
  for each b in campos
    wscript.echo "valor del campo: "&b
  next
 
  if campos(0)=linea then valorbuscado=campos(1): exit do
 
Loop
 
wscript.echo linea
wscript.echo linea2
 
wscript.echo valorbuscado
 
 

Saludos

Despues de cerrar las ventanas con unload añade End y se cerrara el programa.
Algo asi:

Unload form2
Unload form1
End

Saludos

Algo debo estar haciendo mal, porque mi nombre no aparece en la lista de errores  

Private Function IsNumeric_PKJ(Cadena As String) As Boolean
  Dim Valor As Variant
  On Error GoTo Error1
  Valor = CDbl(Cadena)
  IsNumeric_PKJ = True
Error1:
End Function

O eso o 7913+pkj = 1Genius
EDIT: No, ahora me estoy fijando que 7913 no necesita socios
Su nombre tampoco aparece en la lista de fallos.
EDIT2:
En realidad hemos pensado lo mismo pero al revés.
Supongo que parece que lo he copiado, pero ha sido pura casualidad.
Intentaré buscar otro modo, aunque ya digo que esto esta muy trillado.

EDIT3:
Lo siento. Solo se me ocurren variantes de lo mismo.
Si lo que quiero es saber si es un número no se me ocurre nada mejor que esto, y ya que funciona creo que me conformaré:

Private Function IsNumeric_PKJ(Cadena As String) As Boolean
  On Error GoTo Error1
  If CDbl(Cadena) = 0 Or CDbl(Cadena) <> 0 Then IsNumeric_PKJ = True
Error1:
End Function
 

Por cierto, pensaba que ninguna funcion superaba el test y resulta que hay varias que tampoco dan errores, solo que como no dan errores pasan desapercibidas y no lo habia notado. Por eso cuando me ha funcionado a la primera no me lo creia.
Copie la funcion de 7913 para evitarme escribir el encabezado y cuando vi que era parecida a lo que queria hacer, pense que habia mejorado esa funcion, cuando de por si ya funcionaba.
En fin, creo que darle mas vueltas es complicarse la vida.

Saludos

Es lo que me animó a poner el reto.
Estuve mirando, e incluso he comentado algo, pero en general acabo mareado si intento descifrar los codigos
Trabajais con cosas que nunca he visto o que no entiendo y me hago un lio.


He echado un vistazo y me parece que teneis el tema bien trillado. No creo que se me ocurra nada nuevo. Ni siquiera he usado nunca esa función IsNumeric
De todos modos, al menos lo voy a pensar. Igual salta la liebre.

Saludos

Buen trabajo, BlackZeroX, algo tarde pero muy bueno.

Solo he tenido que retocarla un pelín y es mucho mas rápida que la de muestra.
Parece incluso más rápida que la más rápida que he hecho yo

Function DimeQueHagoB(ByVal Valor1 As Long, ByVal Valor2 As Long, Bits As Byte) As Integer
 
  Dim lV3 As Long
 
  Dim iCount As Byte
 
  lV3 = (Valor1 Xor Valor2)
 
  If lV3 = 0 Then Exit Function
 
  If (Bits > 32) Then Bits = 32
 
  For iCount = 1 To Bits
 
    If (lV3 And &H1) Then
 
      DimeQueHagoB = DimeQueHagoB + 1
 
    ElseIf (lV3 = 0) Then
 
      Exit For
 
    End If
 
    lV3 = lV3 \ 2
 
  Next iCount
 
End Function
 

En VB6 un Long tiene 32 bits, en VB.Net creo que son 64

¿Veis los demás como solo era ponerse?

Saludos

Vaya decepción. Parece que ni siquiera lo habéis intentado.

Lo explicaré brevemente para no haceros perder vuestro tiempo. Las hice para un programa de reducciones 1X2.

La segunda función, la pequeña, compara 2 números binarios a partir de sus equivalentes decimales y devuelve las diferencias. Compara 2 dobles a partir de sus números de orden.

La primera función, la grande, hace lo mismo pero con 2 valores que representan dos potencias de 3. Compara 2 triples.

Las dos se pueden mejorar mucho, pero no voy a entrar en detalles.

Saludos

Para los que quieran intentarlo, aquí os dejo una pista.

Esta es su hermanita pequeña. La otra me costó más sacarla (que borrico).

Function DimeQueHagoB(ByVal Valor1 As Long, ByVal Valor2 As Long, Bits As Integer) As Integer
  Dim Valor3 As Long
  Dim F As Integer
 
  Valor3 = (Valor1 Xor Valor2) 
 
  For F = 0 To Bits - 1
    If Valor3 And (2 ^ F) Then DimeQueHagoB = DimeQueHagoB + 1
  Next F
 
End Function
 

Las dos las tengo ya mejoradas reemplazando las operaciones mas gordas por sus resultados.
Mas código pero más velocidad.

Espero que con esto al menos sepáis lo que son los Trits

Saludos

Quiero proponeros una adivinanza y un reto:

Adivinanza: ¿Que hace esta función que he inventado?
Os dejo las variables con nombres descriptivos para que podais seguirla mejor.
Los mas iniciados seguro que lo adivinan en un vistazo y se ríen de mis métodos.
El caso es que a veces se me enciende la bombilla, pero parpadea mucho

Reto: Mejorar esta función. Fácil.

No es que tenga demasiado interés en que sea más rápida, aunque me gustaría ver el sistema que usaría alguien con conocimientos de matemáticas (o igual hay una API para esto ). Yo en el colegio nunca presté atención

He pensado que son dos buenos retos.

Espero que os animéis muchos.
Si se me ocurre como, yo también la intentaré mejorar (bueno, mas rápido ya se me está ocurriendo: puedo quitar los xor si copio 2 veces el código... o quizás no).

Haced vuestras propias versiones una vez que sepais lo que hace.

Function DimeQueHago(ByVal Valor1 As Long, ByVal Valor2 As Long, Trits As Integer) As Long
  Dim Acu As Integer
  Dim Bloque As Long
  Dim Bloque2 As Long
  Valor1 = Valor1 + 1 ' yo lo uso sin
  Valor2 = Valor2 + 1 ' estas 2 lineas
  If Valor2 > Valor1 Then
    Valor1 = Valor1 Xor Valor2
    Valor2 = Valor1 Xor Valor2
    Valor1 = Valor1 Xor Valor2
  End If
  Bloque = (3 ^ Trits) / 3
  Do Until Bloque = 1
    Bloque2 = Bloque * 2
    If Valor1 > Bloque2 Then
      Valor1 = Valor1 - Bloque2
      If Valor2 > Bloque2 Then
        Valor2 = Valor2 - Bloque2
      Else
        Acu = Acu + 1
        If Valor2 > Bloque Then Valor2 = Valor2 - Bloque
      End If
      GoTo Sort
    End If
 
    If Valor1 > Bloque Then
      Valor1 = Valor1 - Bloque
      If Valor2 > Bloque Then
        Valor2 = Valor2 - Bloque
      Else
        Acu = Acu + 1
      End If
    End If
Sort:
    If Valor2 > Valor1 Then
      Valor1 = Valor1 Xor Valor2
      Valor2 = Valor1 Xor Valor2
      Valor1 = Valor1 Xor Valor2
    End If
    Bloque = Bloque / 3
  Loop
  If Valor1 = Valor2 Then
  Else
    Acu = Acu + 1
  End If
 
  DimeQueHago = Acu
 
 
End Function
 

Lo dicho. Animaos y usad el coco un poco.

Saludos

EDIT:

¿que pasa?
¿no os interesa?
¿estáis deliberando?
¿me he pasado con el reto?
Igual no es tan fácil como pensé.
¿queréis que diga la solución?
¿queréis una pista?