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
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 SubEsta 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!
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