Generador de nombres aleatorios sin repetir con visual basic en hojas diferentes
Que se generen las preguntas en hoja 1(menu) y las preguntas estén en hoja 2 (pregunta 1)y hoja 3 (pregunta 2), la idea es que no se repitan las preguntas y que sean de diferentes áreas por eso dos botones y hojas diferentes para que quede el registro, ojala me puedan ayudar.
2 respuestas
Podría ser algo así
Sub Pregunta1()
Set m = Sheets("menu")
Set p1 = Sheets("Pregunta1")
fila = p1.Cells(1, 3)
If p1.Cells(fila, 1).Value <> "" Then
m.Range("G2").Value = p1.Cells(fila, 1)
p1.Cells(1, 3) = fila + 1
Else
p1.Cells(1, 3) = 1
m.Range("G2").Value = p1.Cells(fila, 1)
End If
Exit Sub
End Sub
Sub Pregunta2()
Set m = Sheets("menu")
Set p2 = Sheets("Pregunta2")
fila = p2.Cells(1, 3)
If p2.Cells(fila, 1).Value <> "" Then
m.Range("G2").Value = p2.Cells(fila, 1)
p2.Cells(1, 3) = fila + 1
Else
p2.Cells(1, 3) = 1
m.Range("G2").Value = p2.Cells(fila, 1)
End If
Exit Sub
End SubPon la macro Pregunta 1 en el pregunta1(algo logico xD jaja)
Y la macro Pregunta2 en el botón pregunta2
Las preguntas hirian en la columna A a partir de la fila 1 y en C1 se almacenaría el numero de fila que va para poder bajar un lugar cada ves que presiones el botón, y sino encuentra más datos vuelve al principio
Los rangos los puedes modificar a tu necesidad y las hojas ocultarlas para que no se vean si te queda más practico porque la macro simplemente hace referencia a ellas, en ningún momento las selecciona
[quote]Si te fue útil esta respuesta no olvides valorarla -
Hola gracias por tu ayuda pero copio la macro en el visual asigno al botón y me sale depurardor error 1004 depurador y esto en amarillo If p2.Cells(fila, 1).Value <> "" Then
Por lo que veo en la imagen, es porque yo le puse "menu", "Pregunta1" y "Pregunta2" y tu tienes los nombres en mayúscula
Recuerda que los nombres en la macro deben ser exactamente iguales a como están escritos en cada hoja
Ejemplo si el nombre de tu hoja es "PrEgUnTa2"
En la macro tiene que decir "Sheets("PrEgUnTa2")"
Prueba revisar eso y me avisas que tal te fue.
PRESIONO EL BOTÓN Y ME LLEVA A ESO, SERA QUE LAS PREGUNTAS LAS ESTOY ASIGNANDO MAL
Era porque tu no ingresaste ningún dato en las celdas donde almacena las filas
Ahora le agregue otra condición, si en esa celda no hay dato o es igual a 0 entonces que le asigne 1 que seria donde empieza tu puedes variarlo arranca antes o después
Sub Pregunta1()
Set m = Sheets("menu")
Set P1 = Sheets("Pregunta1")
If P1.Cells(1, 3).Value = "" Or P1.Cells(1, 3).Value = 0 Then
P1.Cells(1, 3).Value = 1
End If
fila = P1.Cells(1, 3)
If P1.Cells(fila, 1).Value <> "" Then
m.Range("G2").Value = P1.Cells(fila, 1)
P1.Cells(1, 3) = fila + 1
Else
P1.Cells(1, 3) = 1
m.Range("G2").Value = P1.Cells(fila, 1)
End If
Exit Sub
End Sub
Sub Pregunta2()
Set m = Sheets("menu")
Set P2 = Sheets("Pregunta2")
If P2.Cells(1, 3).Value = "" Or P2.Cells(1, 3).Value = 0 Then
P2.Cells(1, 3).Value = 1
End If
fila = P2.Cells(1, 3)
If P2.Cells(fila, 1).Value <> "" Then
m.Range("G2").Value = P2.Cells(fila, 1)
P2.Cells(1, 3) = fila + 1
Else
P2.Cells(1, 3) = 1
m.Range("G2").Value = P2.Cells(fila, 1)
End If
Exit Sub
End Sub
Trata esta macro con un solo botón selecciona las preguntas de ambas hojas sin repetirlas
y esta es la macro, solo cambia la referencia de los range por los que tu manejes
Sub aleatorios()
Dim unicos As New Collection
Dim unicos2 As New Collection
Set h1 = Worksheets("menu")
Set h2 = Worksheets("pregunta 1")
Set h3 = Worksheets("pregunta 2")
cuantos = Val(InputBox("cuantas preguntas?"))
h1.range("b6").CurrentRegion.Clear
Set prg1 = h2.range("b2").CurrentRegion
Set prg2 = h3.range("b2").CurrentRegion
f1 = prg1.Rows.Count
f2 = prg2.Rows.Count
For i = 1 To cuantos
Hoja = WorksheetFunction.RandBetween(1, 2)
If Hoja = 1 Then f = f1 Else f = f2
otro:
num = WorksheetFunction.RandBetween(1, f)
If Hoja = 1 Then
On Error Resume Next
unicos.Add num, CStr(num)
If Err.Number > 0 Then GoTo otro
h1.range("c6").Cells(i, 0) = prg1.Cells(num, 1)
On Error GoTo 0
End If
If Hoja = 2 Then
On Error Resume Next
unicos2.Add num, CStr(num)
If Err.Number > 0 Then GoTo otro
h1.range("c6").Cells(i, 0) = prg2.Cells(num, 1)
On Error GoTo 0
End If
Next i
Set unicos = Nothing: Set unicos2 = Nothing
Set h1 = Nothing: Set h2 = Nothing: Set h3 = Nothing
Set prg1 = Nothing: Set prg2 = Nothing
End Sub