Macro excel para buscador con 4 criterios?

¿Cuál puede ser la forma más eficiente de programar un formulario que posee 4 criterios de búsqueda?

Hice un formulario que busca en base a números de lote usando el código que les anexo.

¿Cómo lo adapto para que funcione con mi nuevo formulario?

La imagen corresponde al nuevo formulario. Y tiene notas del funcionamiento de la búsqueda.

Saludos.

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] = 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
Private Sub Limpio_El_Formulario()
Dim i%, iFase, iEntrega, iTurno
ListBox1.RowSource = ""
For i = 2 To 15: Controls("Textbox" & i) = "": Next
For Each iFase In Fases
  Controls(iFase).Value = False
Next
For Each iEntrega In Entregas
  Controls(iEntrega).Value = False
  Next
For Each iTurno In Turnos
  Controls(iTurno).Value = False
  Next
 Devuelto = False
 RNC = False
 ComboBox1.ListIndex = -1
 TextBox8 = Date
 TextBox9 = Format(Time, "hh:mm:ss am/pm")
 TextBox15 = Date
 TextBox15.Enabled = False
 TextBox14 = Format(Time, "hh:mm:ss am/pm")
 TextBox14.Enabled = False
 TextBox12 = Date
 TextBox12.Enabled = False
 TextBox13 = Format(Time, "hh:mm:ss am/pm")
 TextBox13.Enabled = False
 ToggleButton1.Value = False
 TextBox10 = Date
 TextBox10.Enabled = False
 TextBox11 = Format(Time, "hh:mm:ss am/pm")
 TextBox11.Enabled = False
 ToggleButton2.Value = False
End Sub
Respuesta
1

Esto te puede ayudar

https://youtu.be/YFPWWezYUKc

https://youtu.be/yLB6HoCZ9JI

¡Gracias!  aplique lo que vi en el link pero 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 dos veces solo aparece una vez en el listbox.
  2. cuando uso cualquiera de los criterios de busqueda lote, area, equipo, producto se desconfiguran los encabezados, esto también lo puede ver en la imagen anexa

Como puedo solucionar esto? la idea es que pueda usar los cuatro campos de búsqueda

Dim ws1 As Worksheet, ws2 As Worksheet, FaseS, TurnoS
Private Sub ComboBox3_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(ComboBox3.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(ComboBox3.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 ComboBox2_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(ComboBox2.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(ComboBox2.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 ComboBox1_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(ComboBox1.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(ComboBox1.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 CommandButton2_Click()
'-------
'AGREGAR
'-------
pasar_a_la_hoja 1 + ws1.Cells(Rows.Count, "a").End(xlUp).Row
Limpio_El_Formulario
End Sub
Private Sub TextBox1_Change() 'Eventos de cambio en textbox BUSQUEDA POR LOTES
'------------------
'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(TextBox1.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(TextBox1.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 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 = 43
    .ColumnHeads = True
                    '01 02  03 04  05  06 07 08 09                                                               41 42 43
    .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"
    .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

si es nesesario.

Saludos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Es estrictamente necesario que una aplicación para android e ios se vea diferente

Si una empresa lanza su aplicación en las tiendas para Android y App Store ¿Esta tendría que verse diferente? Ya que he visto aplicaciones de empresas famosas que se ven un poco mejor diseñadas en Iphone ¿Es estrictamente necesario ofrecer una...
2 respuestas

¿Cómo puedo imprimir informe y actualizar tabla usando un "botón de comando"?

Quiero saber como hacer para que en una tabla, dónde el valor predeterminado es "N" al hacer clic en el botón de comando, imprima 1 informe y actualice a "S" el valor de la tabla pero si en cambio, ese campo esta con valor "S" no imprima ni actualice...
2 respuestas

Tengo una duda access 2010 Reporte vba

Tengo la siguiente sintaxis para filtrar un reporte pero no se filtra no se que tenga mal. DoCmd.OpenReport "ALLM2CONTEDOR", acViewPreview, "FECHA = #" & Format(Me.FECHAOK, "mm-dd-yyyy") & " # AND CONTENEDOR= " & Me.NUMEROCONTENEDOR.Column(1) & ""...
2 respuestas

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...
4 respuestas

How much does it cost to hire a professional app developer Dubai

Hello! If you have finally decided to have an app for your business, you need to look for a TOP MOBILE APP DEVELOPMENT AGENCY DUBAI. It doesn't matter if you are creating an app from scratch or re-launching the pre-existing one. You need to hire a...
11 respuestas

Puedo utilizar más de 258 caracteres en la instrucción DoCmd. ¿RunSQL?

Estoy utilizando un formulario de una tabla y quisiera que parte de esos datos se traspasaran a otra tabla, pero resulta que hasta ahora lo he hecho pero quiero traspasar más datos y la instrucción es tan grande que no la admite, ¿Se puede ampliar...
4 respuestas

Extraer de campo fecha el mes

Necesito el código para extraer de un capo fecha el mes en letra para insertarlo en otro campo se que no sera difícil pero la verdad no lo se mientras gracias por su ayuda
2 respuestas

No encuentro como usar bien la función sumar.si

He probado con el sumar. Si, y no encuentro la fórmula para que, en D1, me de la suma de B7:B18, sumada a la D7:D18, mientras que el mes de las celdas A7:A18 sea igual a Marzo. Y que en D2 hiciera lo mismo, pero para el mes de abril. Muchas gracias
1 respuesta

Boot para firmar pdf con firma digital

Tengo que firmar numerosos pdf's con firma digital, ¿Habría alguna manera de automatizar la tarea con un boot? La firma se realizaría siempre en la misma hoja dependiendo del documento, tengo dos tipos de documentos. Ejm: Documento 1 simpre la firma...
4 respuestas

Conocer en VBA donde se encuentran las bases de Datos

Necesito a través de VBA conocer el emplazamiento de las Bases de Datos.
3 respuestas