Como definir criterios de búsqueda alfanuméricos

Tengo un userform que hace búsqueda en base a lotes de productos funciona bien buscando lotes numéricos como este 1804532, ahora si por equivocación escribo una letra o carácter especial arroja un error "los tipos no coinciden" y se va al código fuente, necesito:

  1. Que si alguien se equivoca, no me lleve al código fuente, solo salga un mensaje que diga "ingrese solo números".
  2. Y a todas estas surge esta duda ¿cómo puedo hacer que acepte datos alfanuméricos? Ya que es muy probable que haga otro userform donde busque con combinación de números y letras.
  3. Anexo imagen del error y código de búsqueda.

Private Sub CommandButton1_Click()
'------
'Buscar
'------
Dim i&
Limpio_El_Formulario
If TextBox1 = "" Then Exit Sub
Set ws1 = Sheets("Datos")
If ws1.[b3] = "" Then Exit Sub
'---------------\
'Filtro avanzado:ws1.Range(ws1.[b2].End(xlDown).Offset(, -1), ws1.[ab2]).AdvancedFilter 2, ws2.[i1:i2], ws2.[k1:al1], False
'
Set ws2 = Sheets("Auxiliar")
ws2.[i2] = 0 + TextBox1
ws1.Range(ws1.[b2].End(xlDown).Offset(, -1), ws1.[AB2]).AdvancedFilter 2, ws2.[i1:i2], ws2.[k1:AL1], False
'MODIFICAR EL RANGO DE WS1 Y WS2
'---------------/
If ws2.[k2] = "" Then Exit Sub
'---------------------------------------------\
'Reemplazo Id del producto por su descripción:ListBox1.RowSource = ws2.Range("k2:al2").Resize(i - 1).Address(external:=True)
'MODIFICAR AQUI EL RANGO PARA VARIAR LOS TITULOS DEL LISTBOX
'
i = ws2.[k1].CurrentRegion.Rows.Count
ws2.[p1].Resize(i).Copy ws2.[AM1]
With ws2.[f1].CurrentRegion
  ws2.[p2].Resize(i - 1) = "=INDEX(" & _
    .Columns(1).Address & ", MATCH(AM2, " & _
    .Columns(2).Address & ", 0))"
  ws2.[p1].Resize(i) = ws2.[p1].Resize(i).Value
End With
'ws2.[u1].Resize(i).Delete xlShiftUp
'---------------------------------------------/
ListBox1.RowSource = ws2.Range("k2:AL2").Resize(i - 1).Address(external:=True)
'MODIFICAR AQUI EL RANGO PARA VARIAR LOS TITULOS DEL LISTBOX
End Sub

1 Respuesta

Respuesta
1

Para permitir solamente números desde la captura, agrega el siguiente evento a tu textbox.

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
        KeyAscii = 0
    End If
End Sub

Cambia TextBox1 por el nombre de tu textbox.

Con eso solamente aceptará números. Por lo tanto en la búsqueda no tendrás el error.

Si vas a buscar letras y números, deberás quitar esta línea:

ws2.[i2] = 0 + TextBox1

Supongo que en esa línea tienes el error, ya que estás intentando sumar un número 0 a un texto.

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

¡Gracias! Diste en el clavo,.

  1. Con respecto a la línea 0 + textbox1 es correcto al eliminar el 0 + todo funciona bien y no arroja error.
  2. Ahora el código que limita el ingreso de letras y caracteres especiales no lo conocía ya lo añadí a mi lista de aprendizaje gracias. Lo probé y funciono correctamente.

Con esto ya termine este formulario. Voy a hacer a partir de este el segundo formulario que me falta.

Saludos

Ya prácticamente termine mi proyecto ¿podría enviarle el excel para que me ayude a afinar unos detalles o me guie en la resolución de estos detalles?

Saludos

Con todo gusto te ayudo con tus peticiones, pon tu pregunta con el detalle que necesitas y lo reviso, si hay necesidad de que me envíes tu archivo entonces te lo pediré, mientras podemos seguir con la mecánica aquí en todo expertos.

¡Gracias!  tengo los siguientes problemas:

  1. El formulario no muestra todas la coincidencias en ninguno de los criterios de búsqueda por ejemplo como puede ver en la imagen si coloco el lote 1804532 que en la matriz esta registrado tres veces pero al escribir en el textbox de búsqueda solo aparece una vez en el listbox.
  2. Cuando uso cualquiera de los criterios de búsqueda lote, área, equipo, producto se desconfiguran los encabezados, esto también lo puede ver en la imagen anexa, ¿Cómo puedo solucionar esto? La idea es que pueda usar los cuatro campos de búsqueda si es necesario.
  3. El formulario al inicializarse si hago click en cualquiera de los registros devuelve los valores a los controles pero si realizo una búsqueda y hago click en el registro buscado arroja un error que puedes ver en la segunda imagen.
  4. No se como hacer que se grabe en la celda correspondiente a usuario que modifica todo usuario que modifique el mismo registro. Debe concatenarse con el texto no bórralo.

Tengo dos dudas más pero estas serian las más complicadas. Y es mejor ir por partes porque esto es nuevo para mi. Anexo código fuente

Dim ws1 As Worksheet, ws2 As Worksheet, FaseS, TurnoS
Private Sub CommandButton2_Click()
'-------
'AGREGAR
'-------
Pasar_a_la_hoja 1 + ws1.Cells(Rows.Count, "a").End(xlUp).Row
Limpio_El_Formulario
End Sub
Private Sub CommandButton3_Click()
'---------
'Modificar
'---------
With ListBox1
  Pasar_a_la_hoja 0 + .List(.ListIndex, 0)
End With
Set ws1 = Sheets("Defectos")
Limpio_El_Formulario
End Sub
Private Sub CommandButton4_Click()
'--------
'Eliminar
'--------
Dim LR&
With ListBox1
  LR = 0 + .List(.ListIndex, 0)
End With
If MsgBox("¿Confirma eliminación?...", vbYesNo) = vbNo Then Exit Sub
ws1.Cells(LR, "a").Resize(, 10).Delete xlShiftUp
'If ws1.[b3] <> "" Then
  With ws1.Range(ws1.[a2], ws1.[a2].End(xlDown)).Offset(, -1)
    .Formula = "=row()"
    .Value = .Value
  End With
'End If
End Sub
Private Sub ListBox1_Click()
With ListBox1
  If .ListIndex = -1 Then Exit Sub
  TextBox1 = .List(.ListIndex, 0) 'LOte
  ComboBox1 = .List(.ListIndex, 1) ' Producto
  Controls(.List(.ListIndex, 2)) = True
  'If .List(.ListIndex, 2) = "1" Then Fase.Value = True Else Fase.Value = False
  ComboBox2 = .List(.ListIndex, 3) ' Áreas
  ComboBox3 = .List(.ListIndex, 4) ' Equipos
  TextBox26 = CDate(.List(.ListIndex, 5)) ' Fecha detección
  TextBox27 = Format(.List(.ListIndex, 6), "hh:mm:ss am/pm") 'Hora detección
  'Usuario 7
  Controls(.List(.ListIndex, 8)) = True
  Textbox3 = .List(.ListIndex, 9)
  TextBox4 = .List(.ListIndex, 10)
  TextBox5 = .List(.ListIndex, 11)
  TextBox6 = .List(.ListIndex, 12)
  TextBox7 = .List(.ListIndex, 13)
  TextBox8 = .List(.ListIndex, 14)
  TextBox9 = .List(.ListIndex, 15)
  TextBox10 = .List(.ListIndex, 16)
  TextBox11 = .List(.ListIndex, 17)
  TextBox12 = .List(.ListIndex, 18)
  TextBox13 = .List(.ListIndex, 19)
  TextBox14 = .List(.ListIndex, 20)
  TextBox15 = .List(.ListIndex, 21)
  TextBox16 = .List(.ListIndex, 22)
  TextBox17 = .List(.ListIndex, 23)
  TextBox18 = .List(.ListIndex, 24)
  TextBox19 = .List(.ListIndex, 25)
  TextBox20 = .List(.ListIndex, 26)
  TextBox21 = .List(.ListIndex, 27)
  TextBox22 = .List(.ListIndex, 28)
  TextBox23 = .List(.ListIndex, 29)
  TextBox24 = .List(.ListIndex, 30)
  TextBox25 = .List(.ListIndex, 31)
  If .List(.ListIndex, 32) = "1" Then CheckBox1.Value = True Else CheckBox1.Value = False
  If .List(.ListIndex, 33) = "1" Then CheckBox2.Value = True Else CheckBox2.Value = False
  If .List(.ListIndex, 34) = "1" Then CheckBox3.Value = True Else CheckBox3.Value = False
  If .List(.ListIndex, 35) = "1" Then CheckBox4.Value = True Else CheckBox4.Value = False
  If .List(.ListIndex, 36) = "1" Then CheckBox5.Value = True Else CheckBox5.Value = False
  If .List(.ListIndex, 37) = "1" Then CheckBox6.Value = True Else CheckBox6.Value = False
  If .List(.ListIndex, 38) = "1" Then CheckBox9.Value = True Else CheckBox9.Value = False
  If .List(.ListIndex, 39) = "1" Then RNC.Value = True Else RNC.Value = False 'RNC
  If .List(.ListIndex, 40) = "1" Then Reproceso.Value = True Else Reproceso.Value = False 'Reproceso
  If .List(.ListIndex, 41) = "1" Then Revision100.Value = True Else Revision100.Value = False 'Revision100%
  If .List(.ListIndex, 42) = "1" Then Rechazado.Value = True Else Rechazado.Value = False 'Rechazado
  'Usuario modifador 43
  TextBox2 = .List(.ListIndex, 44) & "    " & "Registrado por:" & "  " & .List(.ListIndex, 7) & "    " & "Modificado por:" & "  " & .List(.ListIndex, 43) 'Observaciones
  End With
End Sub
Private Sub TextBox28_Change()
'---------------------
'BUSQUEDA POR PRODUCTO
'---------------------
On Error Resume Next
Set b = Sheets("Defectos") 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox28.Value) = "" Then
     Me.ListBox1.List() = b.Range("A2:AR" & uf).Value
     Me.ListBox1.RowSource = "Defectos!A2:AR" & uf 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
Me.ListBox1.ColumnHeads = True
For i = 2 To uf
   strg = b.Cells(i, 2).Value 'Aqui cambio la "COLUMNA" CRITERIO DE BUSQUEDA
   If UCase(strg) Like UCase(TextBox28.Value) & "*" Then 'Aqui se agregan items al listbox
      Me.ListBox1.ColumnCount = 43
       Me.ListBox1.List = Range("a1:ar1").Value 'Esta linea define el rango para que
       Me.ListBox1.ColumnHeads = True           'aparesan todos los items en el lixbox de busqueda
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Format(b.Cells(i, 7), "hh:mm:ss am/pm")
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 38) = b.Cells(i, 39)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 39) = b.Cells(i, 40)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 40) = b.Cells(i, 41)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 41) = b.Cells(i, 42)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 42) = b.Cells(i, 43)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 43) = b.Cells(i, 44)
       End If
Next i
Me.ListBox1.ColumnHeads = True
Me.ListBox1.ColumnWidths = "45;300;55;100;200;70;60;55;55;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;51;62;50"
End Sub
Private Sub TextBox29_Change()
'------------------
'BUSQUEDA POR LOTES
'------------------
On Error Resume Next
Set b = Sheets("Defectos") 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox29.Value) = "" Then
     Me.ListBox1.List() = b.Range("A2:AR2" & uf).Value
     Me.ListBox1.ColumnHeads = True
     Me.ListBox1.RowSource = "Defectos!A2:AR2" & uf 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 1).Value 'Aqui cambio la "COLUMNA" CRITERIO DE BUSQUEDA
   If UCase(strg) Like UCase(TextBox29.Value) & "*" Then 'Aqui se agregan items al listbox
       Me.ListBox1.ColumnCount = 43
       Me.ListBox1.List = Range("a1:ar1").Value 'Esta linea define el rango para que
       Me.ListBox1.ColumnHeads = True           'aparesan todos los items en el lixbox de busqueda
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Format(b.Cells(i, 7), "hh:mm:ss am/pm")
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = b.Cells(i, 10)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = b.Cells(i, 11)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = b.Cells(i, 12)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = b.Cells(i, 13)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = b.Cells(i, 14)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = b.Cells(i, 15)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = b.Cells(i, 16)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = b.Cells(i, 17)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = b.Cells(i, 18)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = b.Cells(i, 19)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = b.Cells(i, 20)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 20) = b.Cells(i, 21)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 21) = b.Cells(i, 22)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 22) = b.Cells(i, 23)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 23) = b.Cells(i, 24)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 24) = b.Cells(i, 25)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 25) = b.Cells(i, 26)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 26) = b.Cells(i, 27)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 27) = b.Cells(i, 28)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 28) = b.Cells(i, 29)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 29) = b.Cells(i, 30)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 30) = b.Cells(i, 31)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 31) = b.Cells(i, 32)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 32) = b.Cells(i, 33)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 33) = b.Cells(i, 34)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 34) = b.Cells(i, 35)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 35) = b.Cells(i, 36)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 36) = b.Cells(i, 37)
       'Me.ListBox1.List(Me.ListBox1.ListCount - 1, 37) = b.Cells(i, 38)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 38) = b.Cells(i, 39)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 39) = b.Cells(i, 40)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 40) = b.Cells(i, 41)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 41) = b.Cells(i, 42)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 42) = b.Cells(i, 43)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 43) = b.Cells(i, 44)
          End If
Next i
Me.ListBox1.ColumnWidths = "45;300;55;100;200;70;60;55;55;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;51;62;50"
'Me.ListBox1.RowSource = "A2:AR2" 'OJO ESTO ES IMPORTANTE PARA LOS EMCABEZADOS SE TOMA LA FILA DESPUES DE ESTOS
Me.ListBox1.ColumnHeads = True
End Sub
Private Sub TextBox30_Change()
'-----------------
'BUSQUEDA POR ÁREA
'-----------------
On Error Resume Next
Set b = Sheets("Defectos") 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox30.Value) = "" Then
     Me.ListBox1.List() = b.Range("A2:AR" & uf).Value
     Me.ListBox1.RowSource = "Defectos!A2:AR" & uf 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
Me.ListBox1.ColumnHeads = True
For i = 2 To uf
   strg = b.Cells(i, 4).Value 'Aqui cambio la "COLUMNA" CRITERIO DE BUSQUEDA
   If UCase(strg) Like UCase(TextBox30.Value) & "*" Then 'Aqui se agregan items al listbox
       Me.ListBox1.ColumnCount = 43
       Me.ListBox1.List = Range("a1:ar1").Value 'Esta linea define el rango para que
       Me.ListBox1.ColumnHeads = True           'aparesan todos los items en el lixbox de busqueda
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Format(b.Cells(i, 7), "hh:mm:ss am/pm")
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 38) = b.Cells(i, 39)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 39) = b.Cells(i, 40)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 40) = b.Cells(i, 41)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 41) = b.Cells(i, 42)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 42) = b.Cells(i, 43)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 43) = b.Cells(i, 44)
   End If
Next i
Me.ListBox1.ColumnHeads = True
Me.ListBox1.ColumnWidths = "45;300;55;100;200;70;60;55;55;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;51;62;50"
End Sub
Private Sub TextBox31_Change()
'-------------------
'BUSQUEDA POR EQUIPO
'-------------------
On Error Resume Next
Set b = Sheets("Defectos") 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox31.Value) = "" Then
     Me.ListBox1.List() = b.Range("A2:AR" & uf).Value
     Me.ListBox1.RowSource = "Defectos!A2:AR" & uf 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
Me.ListBox1.ColumnHeads = True
For i = 2 To uf
   strg = b.Cells(i, 5).Value 'Aqui cambio la "COLUMNA" CRITERIO DE BUSQUEDA
   If UCase(strg) Like UCase(TextBox31.Value) & "*" Then 'Aqui se agregan items al listbox
       Me.ListBox1.ColumnCount = 43
       Me.ListBox1.List = Range("a1:ar1").Value 'Esta linea define el rango para que
       Me.ListBox1.ColumnHeads = True           'aparesan todos los items en el lixbox de busqueda
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Format(b.Cells(i, 7), "hh:mm:ss am/pm")
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 38) = b.Cells(i, 39)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 39) = b.Cells(i, 40)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 40) = b.Cells(i, 41)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 41) = b.Cells(i, 42)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 42) = b.Cells(i, 43)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 43) = b.Cells(i, 44)
   End If
Next i
Me.ListBox1.ColumnHeads = True
Me.ListBox1.ColumnWidths = "45;300;55;100;200;70;60;55;55;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;51;62;50"
End Sub
Private Sub UserForm_Initialize() 'Condiciones del Formulario al inicializarce
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Defectos") 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 45
    .ColumnHeads = True
                    '01 02 03 04 05 06 07 08 09 41 42 43 44
    .ColumnWidths = "45;300;55;100;200;70;60;55;55;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;45;51;62;50;0;0"
    .RowSource = "Defectos!A2:" & wc & uf 'Cambiar aqui el "NOMBRE" de la hoja criterio de bsuqueda
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set ws1 = Sheets("Defectos")
'If ws1.[a2] = "" Then Exit Sub
Set ws2 = Sheets("Auxiliar") 'Combobox1 Productos
With ComboBox1
  .ColumnHeads = True
  .ColumnCount = 2
  .ColumnWidths = "300;0"
  .ListWidth = 300
  .RowSource = ws2.Range(ws2.[f2], ws2.[g1].End(xlDown)).Address(external:=True)
End With
Set ws2 = Sheets("Auxiliar") 'Combobox2 Áreas
With ComboBox2
  .ColumnHeads = True
  .ColumnCount = 2
  .ColumnWidths = "300;0"
  .ListWidth = 300
  .RowSource = ws2.Range(ws2.[d2], ws2.[e1].End(xlDown)).Address(external:=True)
End With
Set ws2 = Sheets("Auxiliar") 'Combobox3 Equipos
With ComboBox3
  .ColumnHeads = True
  .ColumnCount = 2
  .ColumnWidths = "300;0"
  .ListWidth = 300
  .RowSource = ws2.Range(ws2.[b2], ws2.[c1].End(xlDown)).Address(external:=True)
End With
TextBox26 = Date
TextBox27 = Format(Time, "hh:mm:ss am/pm")
FaseS = Array("Envase", "Empaque")
TurnoS = Array("Primero", "Segundo", "SobreTiempo", "Feriado")
End Sub
Private Sub Pasar_a_la_hoja(LR&)
Dim iFase
Dim iTurno
With ws1.Cells(LR, "a")
  .Value = .Row
  .Cells(1, 1) = TextBox1 ' Lote
  .Cells(1, 2) = ComboBox1.Value ' Producto
  .Cells(1, 4) = ComboBox2.Value ' Áreas
  .Cells(1, 5) = ComboBox3.Value ' Equipos
  .Cells(1, 6) = CDate(TextBox26) ' Fecha detección
  .Cells(1, 7) = TextBox27.Value 'Hora detección
  .Cells(1, 8) = Environ("Username") 'Firma de usuario
  .Cells(1, 45) = TextBox2.Value 'Observaciones
  For Each iFase In FaseS
    If Controls(iFase) Then
      .Cells(1, 3) = Controls(iFase).Name
      Exit For
    End If
  Next
For Each iTurno In TurnoS
    If Controls(iTurno) Then
       .Cells(1, 9) = Controls(iTurno).Name
       Exit For
    End If
    Next
ws1.Range(.Cells(1, 10), .Cells(1, 32)).ClearContents
  If Textbox3 <> "" Then .Cells(1, 10) = 0 + Textbox3 ' Desv 01
  If TextBox4 <> "" Then .Cells(1, 11) = 0 + TextBox4 ' Desv 02
  If TextBox5 <> "" Then .Cells(1, 12) = 0 + TextBox5 ' Desv 03
  If TextBox6 <> "" Then .Cells(1, 13) = 0 + TextBox6 'Desv 04
  If TextBox7 <> "" Then .Cells(1, 14) = 0 + TextBox7 'Desv 05
  If TextBox8 <> "" Then .Cells(1, 15) = 0 + TextBox8 ' Desv 01
  If TextBox9 <> "" Then .Cells(1, 16) = 0 + TextBox9 ' Desv 02
  If TextBox10 <> "" Then .Cells(1, 17) = 0 + TextBox10 ' Desv 03
  If TextBox11 <> "" Then .Cells(1, 18) = 0 + TextBox11 'Desv 04
  If TextBox12 <> "" Then .Cells(1, 19) = 0 + TextBox12 'Desv 05
  If TextBox13 <> "" Then .Cells(1, 20) = 0 + TextBox13 ' Desv 01
  If TextBox14 <> "" Then .Cells(1, 21) = 0 + TextBox14 ' Desv 02
  If TextBox15 <> "" Then .Cells(1, 22) = 0 + TextBox15 ' Desv 03
  If TextBox16 <> "" Then .Cells(1, 23) = 0 + TextBox16 'Desv 04
  If TextBox17 <> "" Then .Cells(1, 24) = 0 + TextBox17 'Desv 05
  If TextBox18 <> "" Then .Cells(1, 25) = 0 + TextBox18 ' Desv 01
  If TextBox19 <> "" Then .Cells(1, 26) = 0 + TextBox19 ' Desv 02
  If TextBox20 <> "" Then .Cells(1, 27) = 0 + TextBox20 ' Desv 03
  If TextBox21 <> "" Then .Cells(1, 28) = 0 + TextBox21 'Desv 04
  If TextBox22 <> "" Then .Cells(1, 29) = 0 + TextBox22 'Desv 05
  If TextBox23 <> "" Then .Cells(1, 30) = 0 + TextBox23 'Desv 04
  If TextBox24 <> "" Then .Cells(1, 31) = 0 + TextBox24 'Desv 05
  If TextBox25 <> "" Then .Cells(1, 32) = 0 + TextBox25 ' Desv 01
  If RNC.Value = True Then .Cells(1, 40) = "1"   'Accion RNC
  If Reproceso.Value = True Then .Cells(1, 41) = "1" 'Accion reproceso
  If Revision100.Value = True Then .Cells(1, 42) = "1" 'Accionrevision 100%
  If Rechazado.Value = True Then .Cells(1, 43) = "1" 'Accion rechazado
  If CheckBox1.Value = True Then .Cells(1, 33) = "1L vencida" 'limpieza vencida
  If CheckBox2.Value = True Then .Cells(1, 34) = "1CC" 'CC
  If CheckBox3.Value = True Then .Cells(1, 35) = "1 Ident ause" 'Identificacion ausente
  If CheckBox4.Value = True Then .Cells(1, 36) = "1bpd bpm" 'BPD/BPM
  If CheckBox5.Value = True Then .Cells(1, 37) = "1animales" 'Animales
  If CheckBox6.Value = True Then .Cells(1, 38) = "1 a e sucioc" 'rea equipos sucios
  If CheckBox9.Value = True Then .Cells(1, 39) = "1Higiene" 'Higiene
  'If CommandButton2.Enabled = True Then .Cells(1, 26) = "1"
  If CommandButton3.Enabled = False Then .Cells(1, 44) = "" Else: Cells(1, 44) = Environ("username")
End With
End Sub
Private Sub Limpio_El_Formulario()
Dim i%, iFase, iTurno
ListBox1.RowSource = ""
For i = 2 To 27: Controls("Textbox" & i) = "": Next
For Each iFase In FaseS
  Controls(iFase).Value = False
Next
For Each iTurno In TurnoS
  Controls(iTurno).Value = False
  Next
 RNC = False
 Reproceso = False
 Revision100 = False
 Rechazado = False
 CheckBox1 = False
 CheckBox2 = False
 CheckBox3 = False
 CheckBox4 = False
 CheckBox5 = False
 CheckBox6 = False
 CheckBox9 = False
 ComboBox1.ListIndex = -1
 ComboBox2.ListIndex = -1
 ComboBox3.ListIndex = -1
 TextBox26 = Date
 TextBox27 = Format(Time, "hh:mm:ss am/pm")
 End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
With Sheets("Defectos")
  If .[a2] = "" Then Exit Sub
  '.Range(.[a3], .[a2].End(xlDown)).ClearContents
End With
End Sub

Tienes que crear una nueva pregunta por cada petición

https://www.todoexpertos.com/preguntas/98tvw4wcrxo7enc3/macro-excel-para-buscador-con-4-criterios?selectedanswerid=98uvpa4k66g7gfjo

En el link de arriba puedes ir a la primera parte de esta pregunta la abri hace unos dias y falta un experto por responder no se si es usted.

Si ya te respondió un experto debes insistir hasta que te responda correctamente.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

¿Cómo separo dos números que se encuentran en una sola celda de excel?

En una celda de excel se encuentran dos cantidades separadas por un guion. Quisiera separar el primer número en una segunda celda y el segundo número en una tercer celda. Ejemplo: A 1 48,264 - 65,371 2 55,555 - 66,666 3 . . . Debería quedar así: A B...
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
8 respuestas

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas