Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Mensaje cuando no encuentre valor en una busqueda

poi11

Por poi11
en Macros y programación VBA

Recommended Posts

poi11 Novato

poi11

publicado
publicado

Hola tengo un código q busca un valor en una base de datos lo que quiero es que cuando no encuentre el valor me de un MsgBox que diga "Código no encontrado" se que ya hay preguntas similares pero no he podido adaptarlo a mi código, por cierto ya tiene un MsgBox que avisa cuando se a dejado el campo en blanco

Gracias al que quiera ayudarme yo apenas estoy empezando con esto de las macros

Private Sub CommandButton1_Click()
If TextBox1 = Empty Then
MsgBox "No ha escrito nada en el campo  CODIGO"
Else
Cells.Find(What:=Val(TextBox1), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(0, 1).Select
ComboBox4 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
Calendar1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
Label7 = ActiveCell.Row
CommandButton3.SetFocus
End If
End Sub[/PHP]

Ejemplo.zip

Invitado Cacho R

Invitado Cacho R

publicado
publicado

Hola! poi11. Intenta, por ejemplo, con:

Private Sub CommandButton1_Click()
Dim C As Range

If TextBox1 = Empty Then
  MsgBox "No ha escrito nada en el campo  CODIGO"
  Exit Sub
End If

On Error Resume Next
Set C = Cells.Find(What:=Val(TextBox1), LookIn:=xlFormulas, LookAt:=xlPart, _
  SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
On Error GoTo 0
If C Is Nothing Then
  MsgBox "'" & TextBox1 & "' no fue encontrado."
  Exit Sub
End If

ComboBox4 = C.Offset(, 1)
ComboBox1 = C.Offset(, 2)
ComboBox2 = C.Offset(, 3)
ComboBox3 = C.Offset(, 4)
Calendar1 = C.Offset(, 5)
TextBox3 = C.Offset(, 6)

Label7 = C.Row
Set C = Nothing
CommandButton3.SetFocus
End Sub[/PHP]

poi11 Novato

poi11

publicado
  • Autor
publicado
Hola! poi11. Intenta, por ejemplo, con:

Hola gracias por la ayuda pero vieras que con ese codigo ya no me busca nada mejor voy a subir un ejemplo reducido de lo q estoy haciendo... Y gracias por la ayuda

Ejemplo.zip

Invitado Cacho R

Invitado Cacho R

publicado
publicado
... con ese codigo ya no me busca nada ...

Varias cosas que comentar:

- Por favor: ¡Corrige "eso" de revisión con c... que me pone muy nervioso! (y lo digo en serio aunque me cause gracia).

- Con referencia al código sugerido, no es que no te busca nada. Por el contrario: ¡te encuentra todo! (jajaja)

Hay dos cosillas importantes que tienes que tener en cuenta cuando elaboras un código como éste:

-> ¿Estás seguro que necesitas a la fila 7 en tu programación?... O sea: me parece que si haces un pequeño esfuerzo de análisis verás que si tienes que modificar un dato, pues modificas la fila correspondiente y listo, ¿Se entiende?

-> Habías omitido mencionar algo muy importante: cuando uno escribe un código a buscar en el textbox1, lo que estás haciendo es duplicar ese valor en la celda A7.

Mostraste -inicialmente- tu código sin acompañar un archivo y vemos Cells.Find. "Cells" son todas las celdas de la hoja, o sea que buscas en todas las celdas de la hoja el código ingresado en textbox1.

Por lo tanto "tu mismo te estás pisando" ya que el Find encuentra como primer código el que tu mismo escribiste en A7. ¿Qué datos acompañan a esa fila?... ¡Ninguno! pues esa fila está vacía inicialmente.

¿Entiendes, entonces, que no es que no se encuentra nada sino que se encuentra lo que no se tiene que encontrar?

___

Dos soluciones, entonces:

- Reevalúa el sentido de la fila 7

- O reemplaza Cells por range([a8], cells(rows.count,"a").end(xlup))

Saludos, Cacho R.

poi11 Novato

poi11

publicado
  • Autor
publicado
Varias cosas que comentar:

Bueno perdona por responder hasta ahora pero he estado un poco ocupado con mi trabajo

Bueno por eso de revisión con "C" no me había fijado y por lo demás si es necesaria la fila A7 porque sirve para agregar códigos nuevos lo que hice fue agregar un Textbox dedicado a buscar solamente y le agregue estas lineas al código

Private Sub CommandButton1_Click()
If TextBox4 = Empty Then

MsgBox "No ha escrito nada en el campo  BUSCAR"
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = False
    Sheets("7A").Activate
    On Error GoTo noexiste
If Cells.Find(What:=Val(TextBox4), After:=ActiveCell, LookIn:=xlFormulas, _
 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
 MatchCase:=False, SearchFormat:=True).Activate = True Then

TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox4 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
Calendar1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
Label7 = ActiveCell.Row
CommandButton3.SetFocus
TextBox4 = Empty
End If
Exit Sub
noexiste:
MsgBox "Codigo no existe en inventario"
Application.ScreenUpdating = True
TextBox4 = Empty
TextBox4.SetFocus
End Sub
[/PHP]

Ahora mi problema es que si pongo un "1" en el textbox me busca el primer valor que contenga ese "1" como 044515 cuando no debería

porque no existe el código "1". Alguna sugerencia..???

Gracias por el tiempo ...

Ejemplo.zip

Invitado Cacho R

Invitado Cacho R

publicado
publicado

Hola! poi11

Cuando tengas tiempo de mirar el código que te he pasado, advertirás que NI UNA SOLA VEZ estoy haciendo Activate y/o Select.

En ese sentido he definido un objeto Range llamado "C": ¿te habías dado cuenta?

Te diría que intentes comprender el sentido de eficiencia y precisión que ello conlleva.

Cualquier duda consultas, ¿OK?

poi11 Novato

poi11

publicado
  • Autor
publicado

Hola Cacho R

Bueno solo escribo para mencionar que ya resolví mi problema cuando ingreso un código que no existe me tira un cuadro de mensaje y ahora también hace las búsquedas exactas.

Así que ya pueden cerrar la consulta

Adjunto el codigo para que veas cm me quedo al final

Private Sub CommandButton1_Click()
If TextBox4 = Empty Then
MsgBox "Indroduzca un Código para buscar", vbInformation, "REPORTE REVISIÓN DE FECHAS"
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = True
    Sheets("7A").Activate
    On Error GoTo noexiste
If Range("A:A").Find(What:=Val(TextBox4), After:=ActiveCell, LookIn:=xlFormulas, _
 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
 MatchCase:=False, SearchFormat:=True).Activate = True Then
TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox4 = ActiveCell
TextBox8 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
ComboBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
Calendar1 = ActiveCell
TextBox7 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
Label7 = ActiveCell.Row
ActiveCell.Offset(0, 4).Select
TextBox5 = ActiveCell
ActiveCell.Offset(0, 2).Select
TextBox6 = ActiveCell
CommandButton3.SetFocus
TextBox4 = Empty
End If
Exit Sub
noexiste:
MsgBox "El producto no se encuentra en el Inventario", vbInformation, "PRODUCTO NO ENCONTRADO"
Application.ScreenUpdating = True
TextBox4 = Empty
TextBox4.SetFocus
End Sub[/PHP]

Invitado Cacho R

Invitado Cacho R

publicado
publicado
... Adjunto el codigo para que veas cm me quedo al final...

Que de tu código no hayan "volado" los Select implica que no has podido "sacarle jugo" al código inicialmente sugerido, ni a las recomendaciones posteriores: ¡Una verdadera lástima!

Por decirlo de un modo "elegante": entre dos puntos, la recta es el camino más corto.

Pero que entre ellos existen infinitos caminos que los unen: ¡No hay dudas!

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.