Cómo aplicar búsqueda por tres criterios en distintos documentos
Hola. Como sabes necesito realizar lo hecho en docs anteriores, en nuevos documentos, me podrías explicar por favor qué nomás tengo que cambiar en el código de programación para que me funcione en nuevos documentos, de esta manera también podría entender de mejor manera el código. Podrías utilizar el último documento que me enviaste corregido el tercer filtro, ya que ese documento tiene los filtros definitivos.
Muchas gracias!!
1 respuesta
Respuesta de Dante Amor
1
1

Dante Amor, https://www.youtube.com/@CursosDeExcelyMacros
Son varios cambios los que tienes que hacer, cada vez que cambias una columna de su lugar, hay que modificar las columnas en la macro, te agregué mas comentarios
Public hbd, hej, hfiltro, hpaso, hsubes As Worksheet Public campo1, campo2, campo3 Public campof As Date Private Sub ComboBox1_Change() 'Por.Dam If IsNumeric(ComboBox1) Then campo1 = Me.ComboBox1.Value Else campo1 = Me.ComboBox1.Text & IIf(Me.ComboBox1.Text = "", "", "*") End If filtrar ComboBox2.Clear ComboBox3.Clear 'arreglar "B", "C" y "D" para cada combobox For i = 7 To hbd.Range("B" & Rows.Count).End(xlUp).Row If hbd.Cells(i, "B") = ComboBox1 Then ComboBox2.AddItem hbd.Cells(i, "D") ComboBox3.AddItem hbd.Cells(i, "C") End If Next i End Sub Private Sub ComboBox2_Change() 'Por.Dam Dim wvalor As String If IsNumeric(ComboBox2) Then campo2 = Me.ComboBox2.Value Else campo2 = Me.ComboBox2.Text 'para fecha campof = DateSerial(Val(Mid(campo2, 7, 4)), Val(Mid(campo2, 4, 4)), Val(Mid(campo2, 1, 2))) End If filtrar ComboBox3.Clear 'arreglar "B", "C" y "D" para cada combobox For i = 7 To hbd.Range("B" & Rows.Count).End(xlUp).Row If hbd.Cells(i, "B") = ComboBox1 And _ hbd.Cells(i, "D") = DateSerial(Val(Mid(ComboBox2, 7, 4)), _ Val(Mid(ComboBox2, 4, 4)), Val(Mid(ComboBox2, 1, 2))) Then ComboBox3.AddItem hbd.Cells(i, "C") End If Next i End Sub Private Sub ComboBox3_Change() 'Por.Dam If IsNumeric(ComboBox3) Then campo3 = Val(Me.ComboBox3.Value) Else campo3 = Me.ComboBox3.Text & IIf(Me.ComboBox3.Text = "", "", "*") End If filtrar End Sub Private Sub filtrar() 'Por.Dam Application.ScreenUpdating = False 'limpiear hojas temporales hfiltro.Cells.Clear hpaso.Cells.Clear 'En esta parte tienes que identicar las columnas que se van a cargar en el listbox 'En este ejemplo se cargan hasta la columna J 'entonces la columna J es la final, se requiere en letra y en número 'La columna K es para almacenar el consecutivo colfinlet = "J" 'columna final para cargar los datos en letra colfinnum = Columns(colfinlet).Column 'columna final para cargar los datos en num colfinlet2 = "K" 'columna donde se pone el número de fila 'copia de la bd para numerar el número de fila 'En esta parte se tiene que poner que los datos empiezan en la celda B5 'y acaban en las columnan indicadas anteriormente With hbd .Range("B5:" & colfinlet & _ .Range("B" & Rows.Count).End(xlUp).Row).Copy _ hpaso.Range("B5") For i = 7 To hpaso.Range("B" & Rows.Count).End(xlUp).Row hpaso.Cells(i, colfinnum + 1) = i Next End With 'pasar de paso a filtro los datos filtrados With hpaso With .Range("B5:" & colfinlet2 & .Range("B" & Rows.Count).End(xlUp).Row) If campo1 <> "" Or campo2 <> "" Or campo3 <> "" Then 'Aqui tienes que poner el orden de los campos en el filtrado 'el field 1 corresponde a la columna "B", el filtro se empieza a cargar en la columna "B" 'por lo tanto la columna "B" = 1, la columna "D" = 3 y la columna "C" = 2 If campo1 <> "" Then .AutoFilter Field:=1, Criteria1:=campo1 If campo2 <> "" Then .AutoFilter Field:=3, Criteria1:=campof If campo3 <> "" Then .AutoFilter Field:=2, Criteria1:=campo3 .Copy hfiltro.Range("A1") uf = hfiltro.Range("A" & Rows.Count).End(xlUp).Row If uf > 1 Then Me.ListBox1.ColumnCount = colfinnum - 1 Me.ListBox1.RowSource = "FILTRO!A2:" & colfinlet & uf End If Else hfiltro.Cells.Clear Me.ListBox1.RowSource = "" End If End With If .AutoFilterMode Then .Range("A1").AutoFilter End With Application.ScreenUpdating = True End Sub Private Sub ListBox1_Click() 'por.dam fila = ListBox1.List(ListBox1.ListIndex, 9) limpia_formato If fila = "" Then Exit Sub hej.Select hej.Range("B2").Select hej.Range("C4") = hbd.Cells(fila, "B") 'Subestación hej.Range("I2") = hbd.Cells(fila, "D") 'OT hej.Range("I3") = hbd.Cells(fila, "E") 'fecha hej.Range("I4") = hbd.Cells(fila, "F") 'reprogramada hej.Range("C24:H24") = hbd.Range("AO" & fila & ":AT" & fila).Value 'cold hej.Range("C25:H25") = hbd.Range("AU" & fila & ":AZ" & fila).Value 'hot 'Controla los bloques a copiar col_ini = Array("L", "CG") 'columna inicial de datos de la Base de datos num_col = Array(9, 9) 'número de bloques de 3 a copiar de la base de datos fil_ini = Array(11, 39) 'fila destino en el formato BUSQUEDA For i = LBound(col_ini) To UBound(col_ini) Call copia_de3(col_ini(i), num_col(i), fil_ini(i)) Next End Sub Sub copia_de3(col_ini, col_fin, k) 'copia tres datos, DATO1 (bien, si, temp), DATO2 (mal, no, temp) y observaciones, _ en las columnas D,E y F de BUSQUEDA 'po.dam 'El consecutivo se cargó en la columna "K", la columna "K" corresponde al número 9, 'por eso en esta parte tenemos un 9 fila = ListBox1.List(ListBox1.ListIndex, 9) For j = Columns(col_ini).Column To Columns(col_ini).Column + (col_fin * 3) - 1 hej.Cells(k, "D") = hbd.Cells(fila, j) hej.Cells(k, "E") = hbd.Cells(fila, j + 1) hej.Cells(k, "F") = hbd.Cells(fila, j + 2) j = j + 2 k = k + 1 Next End Sub Private Sub UserForm_Activate() 'por.dam 'Application.ScreenUpdating = False Set hbd = Sheets("BASE DATOS TERMOG") Set hej = Sheets("BUSQUEDA") Set hpaso = Sheets("paso") Set hfiltro = Sheets("FILTRO") Set hsubes = Sheets("SUBESTACIONES") hbd.Visible = True hpaso.Visible = True hfiltro.Visible = True hsubes.Visible = True 'Set bd = Sheets("BASE DATOS") Dim col1 As New Collection On Error Resume Next 'Llena combos con valores únicos ufila = hbd.Range("B" & Rows.Count).End(xlUp).Row For i = 7 To ufila col1.Add Item:=hbd.Cells(i, "B").Value, Key:=CStr(hbd.Cells(i, "B").Value) Next i For i = 1 To ufila AddItem Me.ComboBox1, col1(i) Next i 'Para cargar el título en el form de cada combobox hay que poner b5, d5, c5 'recuerda que tienes que arreglar la fila 5 ya que la tienes combinada y eso no ayuda 'en la ejecución de la macro Label1 = hbd.Range("B5") 'sub Label2 = hbd.Range("D5") 'fecha Label3 = hbd.Range("C5") 'no ot End Sub Sub AddItem(cmbBox As ComboBox, sItem As String) ' agrega los item en orden alfabético 'Por.Dam Dim l As Long For l = 0 To cmbBox.ListCount - 1 Select Case StrComp(cmbBox.List(l), sItem, vbTextCompare) Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega 'Si la comparación es 1, es menor lo agrega en la fila l _ y el valor que ya existe lo recorre hacia abajo Case 1 cmbBox.AddItem sItem, l Exit Sub End Select Next l 'Si en la comparación es mayor lo agrega al final cmbBox.AddItem sItem End Sub Sub limpia_formato() 'Set hej = Sheets("BUSQUEDA") hej.Select hej.Range("C4") = "" 'Subestación hej.Range("I2") = "" 'OT hej.Range("I3") = "" 'fecha hej.Range("I4") = "" 'reprogramada hej.Range("D11:F19") = "" hej.Range("C24:H24") = "" hej.Range("C25:H25") = "" End Sub Private Sub UserForm_Terminate() 'hbd.Visible = False 'hpaso.Visible = False 'hfiltro.Visible = False 'hsubes.Visible = False 'Application.ScreenUpdating = False End Sub
Saludos. Dam
- Compartir respuesta
- Anónimo
ahora mismo
