BuscarV con más de un parámetro
Hola buenos días, tardes o noches (dependiendo de su uso horario) tengo en una hoja una serie de datos, y tengo un botón borrar ultimo, esto borra la ultima línea de datos en hoja1, y debe buscar en la hoja incidencia si se encuentra la ficha y la fecha especificadas en hoja1, estos dos datos se encuentran en la misma fila en diferentes columnas ficha en columna A y fecha en columna B.
Como uso el buscarv para que coincida con esos dos parámetros
Hola elsa, Buenos dias. aqui la macro , y unas imagenes para que veas donde van los datos.
Private Sub BtnBorrar_Click() 'por manuel alejandro escalona peraza '[email protected] On Error GoTo ErrorHandler 'Procedimiento que elimina la ultima fila Encontrada Dim bm3, totm3 As Integer Sheets("Hoja1").Select With Selection Dim UltimaFila As Integer UltimaFila = Range("B1048576").End(xlUp).Row Cells(UltimaFila, 3).Select If ActiveCell.Value <> "" And IsNumeric(ActiveCell.Value) Then Dim guia, Borra, m3, AuxFB, dias, dia2, mes, mes2, año, Ffinal, linea As String Borra = ActiveCell.Value Cells(UltimaFila, 4).Select dias = Day(ActiveCell.Value) dia2 = Format(dias, "00") mes = Month(ActiveCell.Value) mes2 = Format(mes, "00") año = Year(ActiveCell.Value) dia = Weekday(mes2 & "/" & dia2 & "/" & año, vbMonday) Cells(UltimaFila, 6).Select bm3 = ActiveCell.Value Ffinal = año & dia2 & mes2 Cells(UltimaFila - 1, 5).Select guia = ActiveCell.Value Cells(UltimaFila, 6).Select m3 = ActiveCell.Value Dim busco As Object Set busco = Sheets("incidencia").Range("B2:B1048576").Find(val(Ffinal)) If Not busco Is Nothing Then total = total - Borra TotalI = TotalI - Borra If TotalI >= 0 Then TotalI = TotalI End If If TotalI < 0 Then TotalI = 0 End If Totalm3 = Totalm3 - m3 ActiveCell.EntireRow.Delete 'Elimina la ultima fila linea = busco.Row 'MsgBox linea With Sheets("incidencia").Select With Selection Cells(linea, 4).Select Dim borra2, total2 As String borra2 = ActiveCell.Value total2 = borra2 - Borra If total2 > 0 Then ActiveCell.Value = total2 Else ActiveCell.EntireRow.Delete End If Sheets("Hoja1").Select End With End With Else 'MsgBox "NADA" total = total - Borra TotalI = TotalI - Borra Totalm3 = Totalm3 - m3 ActiveCell.EntireRow.Delete 'Elimina la ultima fila End If If dia = 1 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("B4:D4").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 2 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("F4:H4").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 3 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("B8:D8").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 4 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("F8:H8").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 5 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("B12:D12").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 6 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("F12:H12").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If If dia = 7 Then With Sheets("Dias_Mezcladoras").Select With Selection Range("D16:F16").Select m3 = ActiveCell.Value totm3 = m3 - bm3 ActiveCell.FormulaR1C1 = totm3 End With End With End If Sheets("Hoja1").Select Else MsgBox "No Se Puede Borrar Esta Fila", vbSystemModal + vbCritical, "Advertencia" End If End With UltimaGuia = guia Viaje = Viaje - 1 Conta = Conta - 1 Exit Sub ErrorHandler: MsgBox "Ha Ocurrido Un Error Durante El Proceso De Borrado " & Err.Description, vbSystemModal + vbCritical, "ERROR" ' End Sub
Te dejo las instrucciones para una búsqueda por 2 criterios donde se eliminará la fila encontrada... el resto del código no puedo evaluarlo obviamente.
Dim busco As Object
dim esta as byte
Set busco = Sheets("incidencia").Range("B2:B1048576").Find(Val(Ffinal))
If Not busco Is Nothing Then
linea = busco.Row
esta = 0
Do
'controla si se trata de la misma ficha
If Sheets("incidencia").Range("A" & filx) = ActiveSheet.Range("C3") Then
'borra la línea encontrada
Total = Total - Borra
TotalI = TotalI - Borra
If TotalI >= 0 Then
TotalI = TotalI
End If
If TotalI < 0 Then
TotalI = 0
End If
Totalm3 = Totalm3 - m3
Sheets("incidencia").Range("A" & busco.Row).EntireRow.Delete 'Elimina la fila encontrada
'marco que ya está
esta = 1
End If
Set busco = Sheets("incidencia").Range("B2:B1048576").FindNext(busco)
Loop While busco.Row <> linea And esta = 0
'linea = busco.Row
'MsgBox lineaDesde Dim busco hasta 'MsgBox linea son las líneas que debes reemplazar y dejar éstas.
Probalo y si aún necesita algún ajuste tendrás que enviarme el libro con el formulario para poder trabajarlo y probarlo.
Sdos!
Hola elsa,,, gracias por la ayuda, solo una duda más, no entiendo para que sirve la variable esta, ¿y tampoco porque se usa un loop..?
tampoco entiendo el filx... Disculpa mi ignorancia.
Olvidalo Elsa gracias por tu valiosa ayuda... ya comprendí todo el código que me mandaste, MUCHÍSIMAS GRACIAS...
Por si a alguien más le queda la duda.
Cuando se busca por 2 criterios en realidad se busca por el primer criterio (Find), cuando se encuentra un registro se compara si también coincide con el 2do criterio. Por eso el loop para seguir con la búsqueda (FindNext)
Sdos!
