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

1 Respuesta

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

¿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