Una hoja de calculo que me arroje el listado de combinaciones de cruces de ganado

Se quiere hacer una hoja de calculo, que automáticamente se edite la lista de combinaciones de cruces de n cantidad de vacas con n cantidad de toros.

En la hoja 1, se coloca la identificación numérica de las vacas y toros. Ejemplo:

           A           B

1 Toros Vacas

2 1800 2033

3 2333 2309

4                   4328

Mi pregunta es, ¿cómo puedo hacer? Que en la hoja 2, me haga la lista de las combinaciones de cruces de vaca y toros. Ejemplo:

           A             B

1     Toros      Vacas

2     1800        2033

3     1800         2309

4     1800         4328

5      2333         2033

6      2333         2309

7      2333         4328

2 Respuestas

Respuesta
1

Aquí otra macro para considerar:

Sub Cruces()
  Dim c As Range, n As Long
  With Sheets("Hoja1")
    n = .Range("B" & Rows.Count).End(3).Row - 1
    For Each c In .Range("A2", .Range("A" & Rows.Count).End(3))
      Sheets("Hoja2").Range("A" & Rows.Count).End(3)(2).Resize(n).Value = c
      Sheets("Hoja2").Range("B" & Rows.Count).End(3)(2).Resize(n).Value = .Range("B2:B" & n + 1).Value
    Next
  End With
End Sub
Respuesta

Imagino una sencilla solución utilizando arrays.

Sub Macro1()
ini = 2
fin = 10
Dim arr1(1), arrT(), arrV() As String
arr1(0) = "A"
arr1(1) = "B"
t = 0
v = 0
For fila = ini To fin
    For letra = 0 To 1
        stringRang = "" & arr1(letra) & fila & ""
        corral = Hoja1.Range(stringRang).Value
        If corral <> "" Then
            'MsgBox ("estas en el corral " & arr1(letra) & fila)
            Select Case letra
                Case 0 ' A
                    ReDim Preserve arrT(t)
                    arrT(t) = corral
                    t = t + 1
                Case 1 ' B
                    ReDim Preserve arrV(v)
                    arrV(v) = corral
                    v = v + 1
            End Select
        End If
    Next letra
Next fila
newFila = 1
For x = 0 To UBound(arrT)
    For y = 0 To UBound(arrV)
        Hoja2.Range("A" & newFila).Value = arrT(x)
        Hoja2.Range("B" & newFila).Value = arrV(y)
        newFila = newFila + 1
    Next y
Next x
End Sub

Esta macro, recorre las filas del 2 al 20 como esta indicado en el inicio "ini = 2 ; fin = 10"

No importa si hay espacios vacíos, contará hasta el ultimo TORO.

Después cruzara cada toro con cada vaca y los escribe en HOJA2 a partir de A1 y B1

Como única restricción: El último toro siempre debe estar por encima de la última vaca.(Número de fila mayor)

Es decir si escribes el ultimo toro en A9 y hay una vaca en B10, la vaca B10 ya no será contada.
Deberas escribir el toro de A9 en A10 para contar la vaca de B10

¡Gracias! 

Disculpa que no te respondí al momento, acabo de ver la respuesta, la voy aplicar y evaluar la corrida. gracias!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas