Macro que no finalizamos
lo que observe en la macro es que no me va buscando fila a fila en caso que el que ande buscando este en la fila 250
es decir necesito la macro tal cual me la haz hecho pero que busque fila por fila hasta ultimo dato si encuentra el dato exactamente igual según tres criterios lo borre y coloque el nuevo sino encuentra que registre
No se usa la búsqueda línea por línea y menos cuando hay muchos registros. Se hace la búsqueda con la orden find que lo hace mucho más rápido que si la macro fuera comparando línea por línea. Aunque la implementación es algo más difícil.
Esta es la macro, la pongo por si puede aprovecharla alguien, pero te mando el libro pr correo para que no tengas que copiarla y la tengas con el indentado correcto ya que en esta página quitan los espacios extras al copiar-pegar.
Sub REGISTRARSALIDA()
' By ValeroASM
If Date >= DateValue("31/12/2014") Then
Res = MsgBox("LICENCIA EXPIRO Culmino su licencia de uso por favor comuníquese con el proveedor del sistema", vbOKOnly + vbInformation, "Licencia caducada ")
Exit Sub
End If
Dim Rango As Range
Dim BusquedaTerminada As Boolean
Dim CeldaB1, CeldaB2, CeldaB3, CeldaB4, CeldaB5, CeldaDB6, CeldaB7, CeldaB8, CeldaB9, CeldaB10, CeldaB11, CeldaB12, CeldaB13, CeldaD13
Dim Fila, Borrados As Integer
Dim Texto As String
With Worksheets("REGISTRO DE SALIDAS")
CeldaB1 = .Cells(1, "B"): CeldaB2 = .Cells(2, "B")
CeldaB3 = .Cells(3, "B"): CeldaB4 = .Cells(4, "B")
CeldaB5 = .Cells(5, "B"): CeldaB6 = .Cells(6, "B")
CeldaB7 = .Cells(7, "B"): CeldaB8 = .Cells(8, "B")
CeldaB9 = .Cells(9, "B"): CeldaB10 = .Cells(10, "B")
CeldaB11 = .Cells(11, "B"): CeldaB12 = .Cells(12, "B")
CeldaB13 = .Cells(13, "B"):
End With
If CeldaB5 = "AJUSTE_AL_INVENTARIO" Or CeldaB5 = "INVENTARIO_FINAL_INGREDIENTES_PROCESO" Then
Borrados = 0
If CeldaB1 <> "" And CeldaB2 <> "" And CeldaB3 <> "" And CeldaB4 <> "" And CeldaB5 <> "" And CeldaB6 <> "" And CeldaB7 <> "" And CeldaB8 <> "" And CeldaB9 <> "" And CeldaB10 <> "" And CeldaB11 <> "" And CeldaB12 <> "" And CeldaB13 <> "" Then
Set Rango = Worksheets("BDProcesoYAjuste").Range("F:F").Find(CeldaB6)
If Not Rango Is Nothing Then
BusquedaTerminada = False
Fila = Rango.Row
Do
With Worksheets("BDProcesoYAjuste")
If .Cells(Fila, "G") = CeldaB7 Then
If .Cells(Fila, "H") = CeldaB8 Then
If .Cells(Fila, "I") = CeldaB9 Then
.Rows(Fila).Delete Shift:=xlUp
Borrados = Borrados + 1
End If
End If
End If
Set Rango = .Range("F:F").FindNext(.Cells(Fila - 1, "F"))
If Rango Is Nothing Then
BusquedaTerminada = True
Else
Fila = Rango.Row
End If
End With
Loop Until BusquedaTerminada
End If
With Worksheets("BDProcesoYAjuste")
.Rows("3:3").Insert Shift:=xlDown
.Cells(3, "A") = CeldaB1: .Cells(3, "B") = CeldaB2
.Cells(3, "C") = CeldaB3: .Cells(3, "D") = CeldaB4
.Cells(3, "E") = CeldaB5: .Cells(3, "F") = CeldaB6
.Cells(3, "G") = CeldaB7: .Cells(3, "H") = CeldaB8
.Cells(3, "I") = CeldaB9: .Cells(3, "J") = CeldaB10
.Cells(3, "K") = CeldaB11: .Cells(3, "L") = CeldaB12
.Cells(3, "M") = CeldaB13
Texto = "La SALIDA FUE REGISTRADA EXITOSAMENTE"
If Borrados <> 0 Then
Texto = Texto & vbCrLf & vbCrLf & "BORRÉ " & Str(Borrados) & " REGISTRO(S)."
End If
MsgBox (Texto)
If MsgBox("DESEA SEGUIR REGISTRANDO EL MISMO DOCUMENTO DE SALIDA", vbYesNo, "o pasa a el registro de otro documento") = vbYes Then
'Haga algo aquí
Else
'Seleccionó NO, no haga nada
End If
End With
Else
MsgBox ("HAY ALGUNA CELDA VACÍA O ESTA SACANDO MAS DE LO QUE HAY EN EXISTENCIA" & vbCrLf & "CHEQUEE NUEVAMENTE ")
End If
End If
End Sub
Ahora te mando el fichero, ojalá te sirva.
