Macro para ejecutar en hojas determinadas del Libro ?
Tengo esta macro que quisiera que se ejecute en hojas determinadas del libro
Private Sub CommandButton1_Click()
Dim NX As Integer, N2 As Integer
Dim CX As Integer, C2 As Integer, SEL As Integer
If Not IsNumeric(TextBox1) Then
MsgBox "Cantidad X incorrecta"
Exit Sub
End If
If Not IsNumeric(TextBox2) Then
MsgBox "Cantidad 2 incorrecta"
Exit Sub
End If
If CheckBox1 Then Combinar
Application.ScreenUpdating = False
NX = CInt(TextBox1)
N2 = CInt(TextBox2)
For y = [B18] + 3 To 4 Step -1
CX = 0: C2 = 0: SEL = 0
For x = 0 To 13
If ListBox1.Selected(x) Then
SEL = SEL + 1
If Cells(x + 1, y) = "X" Then CX = CX + 1
If Cells(x + 1, y) = "2" Then C2 = C2 + 1
End If
Next
If SEL > 0 Then
If Not (CX = NX And C2 = N2) Then
Cells(1, y).Resize(14, 1).Delete shift:=xlToLeft
[B18] = [B18] - 1
End If
End If
Next
Application.ScreenUpdating = True
End Sub
1 Respuesta
No aclaras donde está este código o este botón de comando.
Si lo tenés en una hoja ... y lo necesitas en otras también, tendrás que dibujar el mismo botón con la misma macro en cada hoja que necesites.
Si en cambio se trata de un botón de un Userform, y necesitas que se recorran celdas de cierta hoja (For y = [B18] + 3 To 4 Step -1) debes aclararlo anteponiendo la hoja, por ejemplo:
For y = hox.[B18] + 3 To 4 Step -1
donde hox fue declarada como: Set hox = Sheets("tuhoja") antes de este bucle for.
Si aún te quedan dudas debes aclarar todo un poco más (dónde está este botón, si es en un UF desde qué hoja se ejecuta, cómo indicarle a Excel de cuál hoja se trata, etc)
voy a detallar mas la macro completa, en un modulo esta macro.
Sub Combinar()
Dim x, y
Dim Apuesta As String, Total As Long
Dim Apuestas() As String
Dim Partidos(14) As String
'-------------------------------------------------------------------------------
Total = 1
For x = 1 To 14
Partidos(x) = CStr(Cells(x, 1))
Total = Total * Len(Cells(x, 1))
Next
If Total > 16000 Then
MsgBox "*** La combinación sobrepasa el máximo permitido (16.000) ***", vbCritical
Exit Sub
End If
ReDim Apuestas(13, Total)
'--
Application.ScreenUpdating = False
Borrar
'---------------------------------------------------------------------------------
For x1 = 1 To Len([A1]): For x2 = 1 To Len([A2]): For x3 = 1 To Len([A3])
For x4 = 1 To Len([A4]): For x5 = 1 To Len([A5]): For x6 = 1 To Len([A6])
For x7 = 1 To Len([A7]): For x8 = 1 To Len([A8]): For x9 = 1 To Len([A9])
For x10 = 1 To Len([A10]): For x11 = 1 To Len([A11]): For x12 = 1 To Len([A12])
For x13 = 1 To Len([A13]): For x14 = 1 To Len([A14])
y = y + 1
Apuestas(0, y) = Mid(Partidos(1), x1, 1)
Apuestas(1, y) = Mid(Partidos(2), x2, 1)
Apuestas(2, y) = Mid(Partidos(3), x3, 1)
Apuestas(3, y) = Mid(Partidos(4), x4, 1)
Apuestas(4, y) = Mid(Partidos(5), x5, 1)
Apuestas(5, y) = Mid(Partidos(6), x6, 1)
Apuestas(6, y) = Mid(Partidos(7), x7, 1)
Apuestas(7, y) = Mid(Partidos(8), x8, 1)
Apuestas(8, y) = Mid(Partidos(9), x9, 1)
Apuestas(9, y) = Mid(Partidos(10), x10, 1)
Apuestas(10, y) = Mid(Partidos(11), x11, 1)
Apuestas(11, y) = Mid(Partidos(12), x12, 1)
Apuestas(12, y) = Mid(Partidos(13), x13, 1)
Apuestas(13, y) = Mid(Partidos(14), x14, 1)
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
'---------------------------------------------------------------------------------
Range(Range("C1"), Cells(14, Total + 3)) = Apuestas
[B18] = Total
End Sub
en userform1
Private Sub CommandButton1_Click()
Dim NX As Integer, N2 As Integer
Dim CX As Integer, C2 As Integer, SEL As Integer
If Not IsNumeric(TextBox1) Then
MsgBox "Cantidad X incorrecta"
Exit Sub
End If
If Not IsNumeric(TextBox2) Then
MsgBox "Cantidad 2 incorrecta"
Exit Sub
End If
If CheckBox1 Then Combinar
Application.ScreenUpdating = False
NX = CInt(TextBox1)
N2 = CInt(TextBox2)
For y = [B18] + 3 To 4 Step -1
CX = 0: C2 = 0: SEL = 0
For x = 0 To 13
If ListBox1.Selected(x) Then
SEL = SEL + 1
If Cells(x + 1, y) = "X" Then CX = CX + 1
If Cells(x + 1, y) = "2" Then C2 = C2 + 1
End If
Next
If SEL > 0 Then
If Not (CX = NX And C2 = N2) Then
Cells(1, y).Resize(14, 1).Delete shift:=xlToLeft
[B18] = [B18] - 1
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
ListBox1.List = Range("A1:A14").Value
End Sub
El dideño de las hojas es el mismo, si voy hoja por hoja se ejecuta la macro con los datos difrentes que hay en cada hoja en A1:A14
Y lo que pretendo es que ejemplo desde hoja 1 al ejecutra la macro se ejecute desde Hoja1 a Hoja10
Un Saludo.
La macro COMBINAR se ejecuta en la hoja 'activa' dejando un resultado en [B18].
Luego desde tu Userform, luego de ejecutar esta macro, recorre esa hojas desde celda [B18]
Entonces, si necesitas ejecutar la combinación y luego el bucle For en 'cierta hoja' debes seleccionarla previamente a la llamada, por ej:
If CheckBox1 Then
Sheets(1).select 'aquí la hoja que necesites
Combinar
end if
'otras líneas
For y = [B18] + 3 To 4 Step -1 'se recorrerá el rango de la hoja seleccionada
Pero si necesitas repetir el proceso con todas las hojas, de 1 a 10, necesitas iniciar otro bucle.
Por ej:
For i = 1 to 10
sheets(i).select 'seleccionar la 1° hoja si i = 1
call COMBINAR
'si hay que recorrer desde el resultado [B18] aquí incluirás el resto de tus instrucciones
Next i
Con Next i se pasará a la hoja2 y repetirá la macro y el bucle For y = [B18] de tu segunda hoja y así con todas.
Espero se haya entendido sino enviame tu libro a mi correo aclarando con un ejemplo el proceso.
Sdos!
Como no veo tu correo te dejo este enlace con el libro.
https://www.dropbox.com/s/fvd42ydr68p1t0k/FORO%20ELSA.xlsm?dl=0
Esta macro me la hicieron yo de macros entiendo lo más básico y me lio en tus explicaciones donde acoplarlo exactamente.
Como podrás ver desde hoja QUINIELA 1 a QUINIELA 10 todas son la misma plantilla, salvo los datos en A1:A14 que son diferentes en cada hoja.
Ejecutando la macro desde QUINIELA 1 >FILTRAR> la ventana que sale selecciono las celdas que considero oportunas y selecciono recalcular combinación antes de filtrar y en icono de venta FILTRAR, esta operación tarda en una hoja unos 18 segundos.
Pues esta operación que hace en una hoja QUINIELA 1 hacerlo en el resto de hojas hasta la hoja QUINIELA 10.
Espero haberme explicado bien.
Un Saludo.
El código para el Userform1 queda así:
Private Sub CommandButton1_Click() Dim NX As Integer, N2 As Integer Dim CX As Integer, C2 As Integer, SEL As Integer For i = 1 To 10 'se recorren las 10 hojas de Quiniela Sheets("QUINIELA " & i).Select 'se llena el listbox con datos de la hoja activa ----confirmar ListBox1.List = Range("A1:A14").Value If Not IsNumeric(TextBox1) Then MsgBox "Cantidad X incorrecta" Exit Sub End If If Not IsNumeric(TextBox2) Then MsgBox "Cantidad 2 incorrecta" Exit Sub End If If CheckBox1 Then Combinar Application.ScreenUpdating = False NX = CInt(TextBox1) N2 = CInt(TextBox2) For y = [B18] + 3 To 4 Step -1 CX = 0: C2 = 0: SEL = 0 For x = 0 To 13 If ListBox1.Selected(x) Then SEL = SEL + 1 If Cells(x + 1, y) = "X" Then CX = CX + 1 If Cells(x + 1, y) = "2" Then C2 = C2 + 1 End If Next If SEL > 0 Then If Not (CX = NX And C2 = N2) Then Cells(1, y).Resize(14, 1).Delete shift:=xlToLeft [B18] = [B18] - 1 End If End If Next Application.ScreenUpdating = True 'pasa a la hoja sgte ------si hay que limpiar el UF quitar la comilla de la siguiente línea 'textbox1 = "":textbox2 = "" Next i MsgBox "Fin del proceso" End Sub Private Sub UserForm_Initialize() 'ListBox1.List = Range("A1:A14").Value 'esta ya no va End Sub
Mi código va explicado por lo que podrás leerlo y ajustarlo.
Estoy considerando que la lista será el rango de la col A de cada hoja que se active.
Si al finalizar con una hoja se deben limpiar los textbox para introducir otros valores, habilitar la línea comentada (quitarle la comilla inicial)
Lo del evento Initialize ya no va.
Probala y si te queda alguna duda podes enviarme el libro al correo cibersoftPUNTOargARROBAgmail.com
Sdos!
Hola Elsa.
Cualquiera de estos dos correos no son validos cibersoftPUNTOargARROBAgmail.com
cibersoftPUNTOargARROBA @ gmail.com cibersoftPUNTOarg @ gmail.com
La macro que me das no vale, si observas cuando en hoja QUINIELA 1 pinchas en el icono de filtrar al abrirse la ventana del dibujo de UserForm faltan datos necesarios para rellenar a la izquierda, mira el libro original y lo veras.
Por otro lado retocando la macro hasta donde se y es muy poco, solo recorre las hojas pero no ejecuta la macro en cada una de las hojas.
Un Saludo.
Debes reemplazar lo que está en mayúsculas por el signo porque si coloco el punto en este foro se transforma y ya no queda como una dirección.
O podías haberme dejado tu correo...
O podías haber ingresado a mi sitio que no muerde... no hay publicidad allí ni se te registra !
A ver: cibersoft PUNTO arg ARROBA gmail.com
Entre cibersoft y arg va un punto (nada de espacios) y entre arg y gmail va la arroba (sin espacios)
Sdos!
Con respecto a tus últimas pruebas no debieras retocar nada ya que hace lo que se observa en la imagen.
Mira:
For i = 1 To 10 'se recorren las 10 hojas de Quiniela Sheets("QUINIELA " & i).Select 'se llena el listbox con datos de la hoja activa ----confirmar ListBox1.List = Range("A1:A14").Value
En estas líneas se le indica que recorra de 1 a 10 hojas que se llaman QUINIELA
Entonces, cuando i = 1 selecciona la hoja llamada QUINIELA 1 y vuelca a la lista el rango A1:A14.
Cuando al final se le indica Next i vuelve aquí ... y ahora i = 2 ... entonces selecciona la hoja QUINIELA 2 y copia el rango de esta hoja a la lista... repitiendo el resto de tu proceso que no fue retocado en nada... está tal cual lo tenías.
No tienes porqué saber de códigos, cada uno a lo suyo. Pero debes confiar en lo que recibes. Si algo no se ejecuta como esperas puede deberse a x razones... pero de ahi a decir que La macro que me das no vale, no me suena bien.
Una razón podría ser que tus hojas no se llamen como QUINIELAespacio2 quizás se llame sin espacios o tienes un espacio al inicio o al final... por eso se te solicita tu libro para comprobarlo.
Sdos!
- Compartir respuesta