Como filtrar 3 ComboBox en una misma base de datos
Quisiera saber como se pueden filtrar 3 combo box con diferentes columnas ejemplos los envíe por correo electrónico.
Respuesta de Dante Amor
1
Te anexo las macros actualizadas
Dim h1, h2
Private Sub cmbPrintingService_Change()
'Por.Dante Amor
ComboBox1 = ""
ComboBox1.Clear
If cmbPrintingService.ListIndex = -1 Or cmbPrintingService = "" Then
Exit Sub
End If
h2.Cells.Clear
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("$A$1:$AH$" & u).AutoFilter Field:=9, Criteria1:=cmbPrintingService
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:A" & u).Copy h2.Range("A1")
u = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlYes
h1.ShowAllData
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u
ComboBox1.AddItem h2.Cells(i, "A")
Next
End Sub
'
Private Sub ComboBox1_Change()
'Por.Dante Amor
Call LimpiarTxt
ComboBox2 = ""
ComboBox2.Clear
'
If ComboBox1.ListIndex = -1 Or ComboBox1 = "" Then
Exit Sub
End If
'
On Error Resume Next
h1.ShowAllData
On Error GoTo 0
h2.Cells.Clear
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("$A$1:$AH$" & u).AutoFilter Field:=9, Criteria1:=cmbPrintingService
h1.Range("$A$1:$AH$" & u).AutoFilter Field:=1, Criteria1:=ComboBox1
'
u = h1.Range("F" & Rows.Count).End(xlUp).Row
h1.Range("F1:F" & u).Copy h2.Range("A1")
u = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlYes
h1.ShowAllData
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u
ComboBox2.AddItem h2.Cells(i, "A")
Next
End Sub
'
Private Sub ComboBox2_Change()
'Por.Dante Amor
Call LimpiarTxt
If ComboBox2.ListIndex = -1 Or ComboBox2 = "" Then
Exit Sub
End If
'
fila = ""
If IsNumeric(ComboBox2) Then modelo = Val(ComboBox2) Else modelo = ComboBox2
Set r = h1.Columns("A")
Set b = r.Find(ComboBox1, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h1.Cells(b.Row, "F") = modelo Then
fila = b.Row
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If fila = "" Then Exit Sub
'
txtIncont = h1.Range("C" & fila).Value
txtFincont = h1.Range("D" & fila).Value
txtCant = h1.Range("E" & fila).Value
txtEquipo = h1.Range("F" & fila).Value
txtTecno = h1.Range("G" & fila).Value
txtNs = h1.Range("B" & fila).Value
txtVprev = h1.Range("H" & fila).Value
txtUbicacion = h1.Range("H" & fila).Value
txttinta = h1.Range("K" & fila).Value
txtadt1 = h1.Range("M" & fila).Value
txtadt2 = h1.Range("O" & fila).Value
txtfiltro1 = h1.Range("Q" & fila).Value
txtfiltro2 = h1.Range("S" & fila).Value
txtfiltro3 = h1.Range("U" & fila).Value
txtrefa1 = h1.Range("W" & fila).Value
txtrefa2 = h1.Range("Y" & fila).Value
txtrefa3 = h1.Range("AA" & fila).Value
txtrefa4 = h1.Range("AC" & fila).Value
txtrefa5 = h1.Range("AE" & fila).Value
txtctinta = h1.Range("L" & fila).Value
txtcadt1 = h1.Range("N" & fila).Value
txtcadt2 = h1.Range("P" & fila).Value
txtcfiltro1 = h1.Range("R" & fila).Value
txtcfiltro2 = h1.Range("T" & fila).Value
txtcfiltro3 = h1.Range("V" & fila).Value
txtcrefa1 = h1.Range("X" & fila).Value
txtcrefa2 = h1.Range("Z" & fila).Value
txtcrefa3 = h1.Range("AB" & fila).Value
txtcrefa4 = h1.Range("AD" & fila).Value
txtcrefa5 = h1.Range("AF" & fila).Value
txtplanta = h1.Range("AG" & fila).Value
'
If txtctinta >= 1 Then
txtttinta = Val(txtctinta) * Val(txtCant)
Else
txtttinta = "CERO"
End If
'
If txtcadt1 >= 1 Then
txttadt1 = Val(txtcadt1) * Val(txtCant)
Else
txttadt1 = "CERO"
End If
If txtcadt2 >= 1 Then
txttadt2 = Val(txtcadt2) * Val(txtCant)
Else
txttadt2 = "CERO"
End If
'
If txtcfiltro1 >= 1 Then
txttfiltro1 = Val(txtcfiltro1) * Val(txtCant)
Else
txttfiltro1 = "CERO"
End If
'
If txtcfiltro2 >= 1 Then
txttfiltro2 = Val(txtcfiltro2) * Val(txtCant)
Else
txttfiltro2 = "CERO"
End If
'
If txtcfiltro3 >= 1 Then
txttfiltro3 = Val(txtcfiltro3) * Val(txtCant)
Else
txttfiltro3 = "CERO"
End If
'
If txtcrefa1 >= 1 Then
txttrefa1 = Val(txtcrefa1) * Val(txtCant)
Else
txttrefa1 = "CERO"
End If
'
If txtcrefa2 >= 1 Then
txttrefa2 = Val(txtcrefa2) * Val(txtCant)
Else
txttrefa2 = "CERO"
End If
'
If txtcrefa3 >= 1 Then
txttrefa3 = Val(txtcrefa3) * Val(txtCant)
Else
txttrefa3 = "CERO"
End If
'
If txtcrefa4 >= 1 Then
txttrefa4 = Val(txtcrefa4) * Val(txtCant)
Else
txttrefa4 = "CERO"
End If
'
If txtcrefa5 >= 1 Then
txttrefa5 = Val(txtcrefa5) * Val(txtCant)
Else
txttrefa5 = "CERO"
End If
End Sub
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
If ComboBox1.ListIndex = -1 Or ComboBox1 = "" Then
MsgBox "Seleciona un Cliente"
Exit Sub
End If
If cmbPrintingService.ListIndex = -1 Or cmbPrintingService = "" Then
MsgBox "Selecciona una Fecha de Preventivo"
Exit Sub
End If
usfMarcasyModelos.Hide
NumSerie.Show
End Sub
'
Private Sub UserForm_Initialize()
'Por.Dante Amor
Set h1 = Hoja3
Set h2 = Sheets("temp")
h2.Cells.Clear
On Error Resume Next
h1.ShowAllData
On Error GoTo 0
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("I1:I" & u).Copy h2.Range("A1")
h2.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlYes
u = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u
cmbPrintingService.AddItem h2.Cells(i, "A")
Next
End Sub
'
Sub LimpiarTxt()
txtIncont = ""
txtFincont = ""
txtCant = ""
txtEquipo = ""
txtTecno = ""
txtNs = ""
txtVprev = ""
txtUbicacion = ""
txttinta = ""
txtadt1 = ""
txtadt2 = ""
txtfiltro1 = ""
txtfiltro2 = ""
txtfiltro3 = ""
txtrefa1 = ""
txtrefa2 = ""
txtrefa3 = ""
txtrefa4 = ""
txtrefa5 = ""
txtctinta = ""
txtcadt1 = ""
txtcadt2 = ""
txtcfiltro1 = ""
txtcfiltro2 = ""
txtcfiltro3 = ""
txtcrefa1 = ""
txtcrefa2 = ""
txtcrefa3 = ""
txtcrefa4 = ""
txtcrefa5 = ""
txtplanta = ""
txtttinta = ""
txttadt1 = ""
txttadt2 = ""
txttfiltro1 = ""
txttfiltro2 = ""
txttfiltro3 = ""
txttrefa1 = ""
txttrefa2 = ""
txttrefa3 = ""
txttrefa4 = ""
txttrefa5 = ""
End Sub
'
Private Sub cmdSalir_Click()
Unload Me
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
