Realizar listado de números de acuerdo a cuadros
Como puedo realizar el listado numérico de acuerdo a los números de los cuadros
Como puedo realizar el proceso repetitivo
Respuesta de Dante Amor
1
El numero que esta en la celda g2, h2, i2, j2 lo quiero en la celda ci1 y así consecutivamente te nvie el libro al correo
Te paso la macro para pasar los números de los 12 cuadros a la columna CI
Sub macroHV()
'Por Dante Amor
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim p As Long, q As Long, x As Long, y As Long
Dim a() As Variant, c As Variant
Dim rng As Range
'
Set rng = Range("G2:R13")
ReDim c(1 To 48 * 12, 1 To 1)
For y = 1 To 3
For x = 1 To 4
Set rng = Range("G2:R13").Offset(p, q)
'rng.Select
q = q + 14
'
Erase a
a = rng.Value
'Horizontal
k = 1
For i = 1 To 9
j = j + 1
c(j, 1) = a(i, k) & a(i, k + 1) & a(i, k + 2) & a(i, k + 3)
k = k + 1
Next i
'Vertical
k = 4
For i = 1 To 9
j = j + 1
c(j, 1) = a(i, k) & a(i + 1, k) & a(i + 2, k) & a(i + 3, k)
k = k + 1
Next i
'Diagonal hacia la derecha
k = 1
m = 1
n = 4
For i = 1 To 9
If n > UBound(a, 2) Then n = UBound(a, 2)
For k = m To n
If k + 1 <= UBound(a, 2) And k + 2 <= UBound(a, 2) And k + 3 <= UBound(a, 2) Then
j = j + 1
c(j, 1) = a(i, k) & a(i + 1, k + 1) & a(i + 2, k + 2) & a(i + 3, k + 3)
End If
Next
k = k + 1
n = n + 1
m = m + 1
Next i
'
Next x
q = 0
p = p + 14
Next y
'
'salida
Range("CI1").Resize(UBound(c, 1)).Value = c
End Sub
