Código Visual Basic para crear una condición
Quiero saber como crear un código para visual basic que me permita crear una condición y poder irla actualizando en la medida que vayan surgiendo cambios
En vez de crear la fórmula en la celda como IF... Quiero hacerlo en Visual Basic para que inserte la información que quiero en la columna escogida para ello
2 respuestas
¿Buenas Yosvanys Guerra Valverde como estas?
¿
¿Podrías explicarme un poco que es lo que deseas hacer?
Para dar una condición mediante VBA con If como dices tu
Por ejemplo si una celda (A1)no esta vacía que en la siguiente celda(B1) escriba Hola seria algo así
Dim rng As Range Set rng = Range("A1") If rng <> "" Then rng.Offset(0, 1).Value = "Hola" End If End Sub
Nose si te refieres a condiciones tipo esta o algo mas elaborado
Aguardo tu respuesta
Un millón de gracias. Te explico yo tengo estas columnas Fecha Bagtag Flight Destination in/out y quiero que la persona que haga el scan en otra celda habilitada para ello ponga el numero de vuelo, el destino y si es inbound o outbound... entonces cuando escanee que el valor introducido en el numero de vuelo aparezca automáticamente en la columna flight por cada escan realizado, en la de destination aparezca el destino de ese vuelo y en la columna in/out si es un vuelo que sale o que entra.. no se si me explico
¿Algo así no te es más practico?
¿La planilla donde tu vas a ingresar los datos y al darle a ingresar lo escribe en la ultima fila vacía?
Hola muchas gracias, me encanta el formulario que me envías,¿podría enviarte el archivo en excel para que entendieras mejor lo que quiero hacer...? Dejame saber si es posible y a cual correo puedo enviártelo
Si, no hay drama, te aclaro que el formulario no copia ni envía nada referido a ninguna celda... es un formulario simple, cada TextBox va dirigido a cada columna copiando datos siempre bajo la última celda con datos
Buenos días Yosvanys Guerra Valverde, ¿si ya lo recibí en el correr de la mañana lo chequeo y veo que podemos hacer ok?
Buenos días Yosvanys Guerra Valverde, te envíe un mail con el archivo, cuando tengas un tiempo revísalo y me dices que te parece
Saludos.
Si es lo que necesitabas no olvides cerrar la pregunta y valorarla =)
Yosvanys me gustaría saber si te sirvió el archivo o tuviste algún inconveniente...
De haberte servido agradezco si calificas la respuesta y cierras la pregunta =)
Excelente Seba, eres un genio, pero necesito hacerle algunos cambios. Quiero trabajar sobre las hojas y no con formularios. He logrado crear este código para mover la información y lo hace, pero necesito, cuando vuelva a introducir datos en la hoja de la que copie, porque eso sucederá continuamente (hoja de bingosheet), pues se introducirán datos por cada vuelo, necesito que me copie la nueva información debajo de la anterior copiada en la hoja de DataBase
Puedo introducir algún código para que copie la nueva información debajo de la existente y que regrese a la hoja de bingosheet y se posicione en la celda B6
Gracias agradezco tu ayuda
Sub Moverdatos()
Sheets("BingoSheet").Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A2")
Continue = MsgBox("Data sent correctly", vbYesNo + vbInformation, strTittle)
If Continue = vbYes Then
With ActiveWorkbook.Sheets(1)
.Range("A6").ClearContents
.Range("b6").ClearContents
.Range("c6").ClearContents
.Range("d6").ClearContents
.Range("e6").ClearContents
.Range("f6").ClearContents
.Range("H1:H3").ClearContents
End With
Else
End If
End Sub
Cambiando esta línea
Sheets("BingoSheet"). Range("A6:F40").Cut Destination:=Sheets("DataBase"). Range("A2")
Por esta
Sheets("BingoSheet"). Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A" & Rows. Count).End(xlUp).Offset(1, 0). Rows
Va a pegar los datos siempre debajo de la ultima fila con datos
Y con esta línea te posicionas sobre B6 en la hoja BingoSheet
Sheets("BingoSheet"). Range("B6").Select
Aunque tu nunca sales de la hoja BingoSheet porque en ningun momento estas seleccionando la hoja DataBase, asi que simplemente podrias poner
Range("B6").Select
Lo que no entendi es tu IF , porque si ya estas cortando todos los datos y pegandolos en la otra hoja para que le dices que limpie el rango (A6:F6) el cual ya esta limpio
Prueba si te sirve de esta forma
Sub Moverdatos() Dim Dx As Object For Each Dx In Range("A6:A40") If Dx.Value <> "" Then Dx.Offset(0, 1).Value = Cells(1, 8).Value Dx.Offset(0, 2).Value = Cells(2, 8).Value Dx.Offset(0, 3).Value = Cells(3, 8).Value Dx.Offset(0, 4).Value = Cells(4, 8).Value Dx.Offset(0, 5).Value = Cells(5, 8).Value End If Next Dx Sheets("BingoSheet").Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Rows Sheets("BingoSheet").Range("B6").Select Continue = MsgBox("Data sent correctly", vbYesNo + vbInformation, strTittle) If Continue = vbYes Then With ActiveWorkbook.Sheets(1) .Range("H1:H3").ClearContents End With Else End If End Sub
Le agregue un "For each" para que busque datos desde A6 hasta A40 si en alguna encuentra datos, ejemplo si en A10 encuentra datos entonces en B10 pega el dato que hay en H1, en C10 pega el H2 en D10 pega H3 en E10 pega H4 y en F10 pega H5
Luego de eso sigue tu macro de cortar todo desde A6 hasta F40 y lo pega debajo de la ultima fila con datos de la hoja data base, si le das que si quieres continuar te limpia H1, H2, H3 lo otro lo elimine porque no tiene sentido ya que no hay nada que borrar también le podrías agregar que borre H4 Y H5 si es que lo deseas
Si te sirvió la macro no olvides valorar la respuesta
[quote]Gracias Seba, eres el mejor. Hice los cambios que me dijiste y funciono a las mil maravillas, en el código que me enviaste me sale esto resaltado como error (lo que esta en negrita)... Pregunta se puede hacer algo desde visual basic para inhabilitar, o sea que no se puedan editar los datos de las columnas a, c,de, ¿e y f y si alguna fila esta incompleta o sea no tiene los datos de CDE no se copien en la hoja de Database?
Sub Moverdatos()
Dim Dx As Object
For Each Dx In Range("A6:A40")
If Dx.Value <> "" Then
Dx.Offset(0, 1).Value = Cells(1, 8).Value
Dx.Offset(0, 2).Value = Cells(2, 8).Value
Dx.Offset(0, 3).Value = Cells(3, 8).Value
Dx.Offset(0, 4).Value = Cells(4, 8).Value
Dx.Offset(0, 5).Value = Cells(5, 8).Value
End If
Next Dx
Sheets("BingoSheet").Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Rows
Sheets("BingoSheet").Range("B6").Select
Continue = MsgBox("Data sent correctly", vbYesNo + vbInformation, strTittle)
If Continue = vbYes Then
With ActiveWorkbook.Sheets(1)
.Range("H1:H3").ClearContents
End With
Else
End If
End Sub
De esta forma si H1 o H2 o H3 o H4 oH5 esta vacío te sale un cartel de error y finaliza la macro el mensaje lo puedes editar a tu gusto
¿Le agregue un bloqueo a la hoja database porque tu me habías comentado sino me equivoco que no quieras que puedan editar la hoja puede ser?
Recuerda bloquear la sección de vba sino cualquiera entra a la macro y puede ver la clave
Por cierto la misma es "excel", puedes escribir la que tu quieras.
Sub Moverdatos() Dim Dx As Object For Each Dx In Range("A6:A40") If Range("H1") = "" Or Range("H2") = "" Or Range("H3") = "" Or Range("H4") = "" Or Range("H5") = "" Then MsgBox "Parece que algun dato no fue ingresado, por favor verifique.", vbCritical Exit Sub End If If Dx.Value <> "" Then Dx.Offset(0, 1).Value = Cells(1, 8).Value Dx.Offset(0, 2).Value = Cells(2, 8).Value Dx.Offset(0, 3).Value = Cells(3, 8).Value Dx.Offset(0, 4).Value = Cells(4, 8).Value Dx.Offset(0, 5).Value = Cells(5, 8).Value End If Next Dx Sheets("DataBase").Unprotect "excel" Sheets("BingoSheet").Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Rows Range("B6").Select Continue = MsgBox("Data sent correctly", vbYesNo + vbInformation, strTittle) If Continue = vbYes Then Sheets("DataBase").Protect "excel" With ActiveWorkbook.Sheets(1) .Range("H1:H3").ClearContents End With Else End If End Sub
El error que mencionas era como te dije antes tu nunca seleccionas la hoja "DataBase" estas siempre sobre "BingoSheet" por eso al intentar seleccionarla te dice que no puede ir a la hoja "BingoSheet" porque ya esta sobre ella...
Gracias Seba, puse el código pero, aunque inserto los valores en H1, H2 y H3, y escaneo, cuando voy a hacer el copiado, me sale el mensaje que parece que ningún dato fue copiado y no los copia... ¿Qué podrá ser?.. Ahhh y como le pongo el bloqueo al VB ja ja
Recuerda que te dije que si H1 o H2 o H3 o H4 o H5 están vacíos no te dejara proseguir y tu pusiste datos solo en H1, H2, H3
Cometí un pequeño error coloque el bloqueo dentro del if, osea que si pones "no" no bloqueara la hoja database je je
Cambia la línea
Sheets("DataBase"). Protect "excel"
que esta debajo del if vbyes para abajo de "Range("B6").select"
Para bloquear vba haz lo siguiente
- Ve a la pestaña "Herramientas", selecciona "Propiedades de VBAProject..."
- Click en la pestaña "Proteccion", marca la casilla que dice "Bloquear proyecto para visualización"
- Escribes una clave en los campos de abajo y le das a Aceptar.
- Guardas el archivo y listo, una ves cierres el archivo cuando lo vuelvas a abrir te pedirá clave para ver los códigos VBA
Seba me vas a matar pro bruto... Todo estaba funcionando bien, y el código era perfecto, pero no se que hice que ahora cuando corro la macro, me copia todo bien en la hoja base de datos, pero en las celdas equivocadas, o sea los valores de h1 a h3 los copia en BCD y en B deben ir los bagtags que no me los copia... te comparto el código de nuevo ... mil perdón, solo le adicione el clearcontents para las celdas "a6:F6" del bingosheet.
Sub Moverdatos() Dim Dx As Object For Each Dx In Range("A6:A40") If Range("H1") = "" Or Range("H2") = "" Or Range("H3") = "" Then MsgBox "Parece que algun dato no fue ingresado, por favor verifique.", vbCritical Exit Sub End If If Dx.Value <> "" Then Dx.Offset(0, 1).Value = Cells(1, 8).Value Dx.Offset(0, 2).Value = Cells(2, 8).Value Dx.Offset(0, 3).Value = Cells(3, 8).Value Dx.Offset(0, 4).Value = Cells(4, 8).Value Dx.Offset(0, 5).Value = Cells(5, 8).Value End If Next Dx Sheets("DataBase").Unprotect "excel" Sheets("BingoSheet").Range("A6:F40").Cut Destination:=Sheets("DataBase").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Rows Range("B6").Select Continue = MsgBox("Data sent correctly", vbYesNo + vbInformation, strTittle) If Continue = vbYes Then Sheets("DataBase").Protect "excel" With ActiveWorkbook.Sheets(1) .Range("H1:H3").ClearContents .Range("A6:F6").ClearContents End With Else End If End Sub
Yo sigo sin Entender para que le agregas eso, ¿tu entiendes que no estás copiando verdad? La macro selecciona el rango A6:F40 y mueve todos los datos a la otra hoja
La línea que tu agregas no hace nada porque el rango que le pides que borre ya está vacío
¿Igualmente si yo no mal recuerdo tu no tienes datos en la columna A tienes todas las celdas combinadas y dice "Bingo Sheet" puede ser?
Tienes que cambiar el rango del for each a B6:F40
¡Gracias! Luego te consulto otras cosas.. Sigo orquestando la idea general.. cuento contigo... Eres un genio
¿Ah por qué es un proyecto grande y vas por partes?
Je je Claro, o hay drama mientra entienda lo que quieres hacer te ayudo con gusto
Ya solucuionado... Gracias a ti... estoy feliz... ahora cree esta macro que me permite filtrar los datos, pero me gustaría que en el campo del tag no tener que poner todos los números, me gustaría que cuando escribiera algún numero me buscara todos los que coinciden con ese numero, generalmente pondré los 4 últimos, pero si por ejemplo pongo 663 me aparezcan todos los que continene en cualquier parte esos números..
Este es el código que genero la macro
Sub filtrado()
'
' filtrado Macro
'
'
Range("alldata").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"B7:G8"), CopyToRange:=Range("B13:G13"), Unique:=False
Range("B8:G8").Select
Range("G8").Activate
Selection.ClearContents
End Sub
jajaja, ahora fue que leí la respuesta tuya,,, si la idea es ir avanzando por a poco, y como tu dices así voy aprendiendo para el futuro...
¿Explícame un poco que es lo que hace esa macro porque veo varios rangos donde buscas los tag? ¿Por qué con la otra macro los almacenas en la hoja database en toda la fila B o lo quieres poner en la hoja bingosheet para traer los datos a ingresar? No me quedo muy claro
Te explico
Fecha Bagtag Flight Orig/Dest In/Out Airline
Ella puede buscar por cualquiera de estos campos o la combinación de ellos, por ejemplo si yo pongo en la celda de Flight el numero 58 ella me va a mostrar todos los registros que contienen ese vuelo, si pongo una fecha y el numero de vuelo me muestra todos los registros para esa fecha y ese vuelo... o sea puedo hacer el filtro combinado o especifico... pero en el caso del bagtag, como es un numero largo yo quiero que cuando ingrese una cifra de 4 números me busque todos los tag que contienen esos 4 números... No se si me entiendes, por ejemplo este es un tag 0449118512 yo quiero buscar ese tag pero solo poniendo el numero 8512
Este es el filtro lo hice sobre la base de un video que aparece en youtube y me gusto... En cualquier campo que tu escribas el te busca la información, puedes hacerlo por un campo o la combinación de varios
Pero quiero en la opción del bagtag que me busque los valores que introduzco, no tener que poner el numero completo... Espero ahora me entiendas
¿Te animas a crear una nueva pregunta para estar en un espacio más limpio y cerrar está pregunta? Porque ya se hizo demasiado larga, si creo que te entendí, te sería mucho más práctico buscar con un recién pero ta jeje vamos a buscarle la vuelta para que lo hagas en la hoja, aguardo la nueva pregunta
- Compartir respuesta
Crear una macro para que se adapte a todas las posibilidades que se te puedan ocurrir no es muy posible.
Para que te des una idea,
- La condición es sobre una columna o sobre varias columnas.
- Cuántas condiciones establecerás.
- Las condiciones anidadas serán incluyentes, es decir, si se cumple la condición 1 y la 2 y la 3 y la 4, etc.
- O son excluyentes, si se cumple la condición 1 o la 2 o la 3.
- O pueden ser mixtas, si se cumple la 1 y la 2 o si se cumple la 1 o la 4, etc.
Si pones un ejemplo de lo que tienes, de lo que quieres validar y el resultado que esperas, sería más fácil prepararte un ejemplo.
Sin embargo, te muestro un ejemplo sencillo:
Suponiendo los siguientes datos en la "Hoja1"
Si el estado se encuentra en la columna A de la hoja "condicion", entonces en la columna D que aparezca "Error" de lo contrario que aparezca "Sigue"
Estos son los valores en la hoja "condicion"
Entonces en la hoja "condicion" en la columna A puedes actualizar las condiciones que necesitas.
El código VBA:
Sub Macro4() ' Set h1 = Sheets("Hoja1") 'hoja con datos Set h2 = Sheets("condicion") 'hoja con las condiciones o criterios co1 = "C" 'columna a validar co2 = "D" 'columna para poner el resultado co3 = "A" 'columna con las condiciones (hoja2) fila = 2 'fila inicial de datos ' n1 = Columns(co1).Column n2 = Columns(co2).Column n3 = Columns(co3).Column u1 = h1.Range(co1 & Rows.Count).End(xlUp).Row With h1.Range(co2 & fila & ":" & co2 & u1) .FormulaR1C1 = "=IFERROR(IF(MATCH(RC" & n1 & "," & _ h2.Name & "!C" & n3 & ",0),""Error"",""""),""Sigue"")" .Value = .Value End With End Sub
[Si con el ejemplo tienes para armar tu condición, [no olvides valorar la respuesta].
[Sal u dos
Ok, trate pero no me funciono, quizás sea por inexperiencia. Te voy a dar más detalles para ver como podemos arreglarlo.
La hoja donde se va a poner la información es la 1 y se llama Bingo Sheet
Quiero que el valor que esta en la celda F4 se ponga en la columna DE a partir de la fila 8
Quiero que el valor que esta en la celda F5 se ponga en la columna E a partir de la fila 8 y de la misma forma el valor que esta en la celda F6 se ponga en la columna F a partir de la fila 8, siempre y cuando se introduzca un valor en la celda de la columna C.
Igual me gustaría me ayudaras a crear una macro para que cuando se termine de insertar toda la información de ese vuelo, copie toda esa información en la hoja 3 que se llama dabase y limpe la información que se introdujo en la hoja 1 y cuando inserte los datos de otros vuelos me los copie a continuación de la información del vuelo anterior que ya se había copiado..
Gracias aprecio mucho tu ayuda
- Compartir respuesta