Como escoger aleatoriamente N artículos de una hoja y pegarla en otro libro
Quisiera saber si se puede con una macro realizar el escoger aleatoriamente una N cantidad de artículos que tengo en el libro1 hoja1 columna A con más de 1000 artículos y pegarlo en la hoja1 columna A de un libro nuevo.
1 respuesta
Respuesta de Dante Amor
1
Te anexo la macro
Pon tus datos en la "Hoja1" columna "A", iniciando en la celda "A1"
En la celda A2 pon el número de artículos que requieres aleatorios.
La macro te creará un archivo y en la primer hoja, en la columna A te pondrá los artículos
Sub aleatorio_2()
'Por Dante Amor
Application.ScreenUpdating = False
Dim num As New Collection
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
'
ini = 1 'fila inicial de números
fin = h1.Range("A" & Rows.Count).End(xlUp).Row
n = h1.Range("B1").Value 'N artículos aleatorios
If n = "" Or Not IsNumeric(n) Then
MsgBox "Captura un valor de N artículos aleatorios"
Exit Sub
End If
If n > fin Then
MsgBox "No puedes seleccionar más artículos de los existentes"
Exit Sub
End If
'Crear nuevo libro
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
'Set h2 = Sheets("Hoja4")
j = 1
'
On Error Resume Next
If n < fin Then
Do While num.Count < n
fila = WorksheetFunction.RandBetween(ini, fin)
valor = h1.Cells(fila, "A").Value
num.Add Item:=valor, Key:=CStr(valor)
Loop
For i = 1 To num.Count
h2.Cells(j, "A").Value = num(i)
j = j + 1
Next
Else
h1.Columns("A").Copy h2.Range("A1")
End If
'
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
Dante Amor Excelente amigo funciona al cien, pero si la hoja donde tengo los artículos tuvieran por ejemplo 5 columnas como podría pasar toda la fila completa al nuevo libro, Desde ya muchas gracias.
Utiliza la siguiente:
Sub aleatorio_2()
'Por Dante Amor
Application.ScreenUpdating = False
Dim num As New Collection
Dim f As New Collection
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
'
ini = 1 'fila inicial de números
fin = h1.Range("A" & Rows.Count).End(xlUp).Row
n = h1.Range("B1").Value 'N artículos aleatorios
If n = "" Or Not IsNumeric(n) Then
MsgBox "Captura un valor de N artículos aleatorios"
Exit Sub
End If
If n > fin Then
MsgBox "No puedes seleccionar más artículos de los existentes"
Exit Sub
End If
'Crear nuevo libro
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
'Set h2 = Sheets("Hoja4")
j = 1
'
On Error Resume Next
If n < fin Then
Do While num.Count < n
fila = WorksheetFunction.RandBetween(ini, fin)
valor = h1.Cells(fila, "A").Value
num.Add Item:=valor, Key:=CStr(valor)
f.Add Item:=fila, Key:=CStr(fila)
Loop
For i = 1 To num.Count
fila = f(i)
'h2.Cells(j, "A").Value = num(i)
h1.Rows(fila).Copy h2.Cells(j, "A")
j = j + 1
Next
Else
h1.Columns("A").Copy h2.Range("A1")
End If
'
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
