Código:
Option Explicit
Sub LimpiarDatos()
Dim wsOrigen As Worksheet, wsDestino As Worksheet
Dim ultimaFila As Long, ultimaCol As Long
Dim r As Long, i As Long
Dim c As Range
Dim cols As Variant
Dim anyComma As Boolean
Dim searchRng As Range
Dim key As String
Dim dict As Object
Dim rngToCheck As Range
Dim arrRow As Variant
Dim outRow As Long
Dim headerIsPresent As Boolean
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wsOrigen = ActiveSheet
On Error Resume Next
Set wsDestino = Worksheets("Datos_Limpios")
If Not wsDestino Is Nothing Then wsDestino.Delete
On Error GoTo 0
Set wsDestino = Worksheets.Add(After:=wsOrigen)
wsDestino.Name = "Datos_Limpios"
If wsOrigen.UsedRange Is Nothing Then
MsgBox "No hay datos en la hoja activa.", vbExclamation
GoTo Cleanup
End If
wsOrigen.UsedRange.Copy
wsDestino.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
anyComma = False
Set searchRng = Nothing
On Error Resume Next
Set searchRng = wsDestino.Range("A1", wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp))
On Error GoTo 0
If Not searchRng Is Nothing Then
For Each c In searchRng
If InStr(1, CStr(c.Value & ""), ",") > 0 Then
anyComma = True
Exit For
End If
Next c
End If
If anyComma Then
wsDestino.Columns("A:A").TextToColumns Destination:=wsDestino.Range("A1"), _
DataType:=xlDelimited, Comma:=True, TextQualifier:=xlTextQualifierDoubleQuote
End If
ultimaFila = wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp).Row
For r = ultimaFila To 1 Step -1
If Application.WorksheetFunction.CountA(wsDestino.Rows(r)) = 0 Then
wsDestino.Rows(r).Delete
End If
Next r
ultimaFila = wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp).Row
If ultimaFila = 0 Then
MsgBox "No quedan datos después de eliminar filas vacías.", vbExclamation
GoTo Cleanup
End If
ultimaCol = wsDestino.Cells(1, wsDestino.Columns.Count).End(xlToLeft).Column
If ultimaCol = 0 Then ultimaCol = 1
For Each c In wsDestino.Range(wsDestino.Cells(1, 1), wsDestino.Cells(ultimaFila, ultimaCol))
If Not IsError(c.Value) Then
If Len(CStr(c.Value & "")) > 0 Then
c.Value = Trim(CStr(c.Value))
End If
End If
Next c
headerIsPresent = False
For i = 1 To ultimaCol
If Len(CStr(wsDestino.Cells(1, i).Value & "")) > 0 Then
If Not IsNumeric(wsDestino.Cells(1, i).Value) Then
headerIsPresent = True
Exit For
End If
End If
Next i
If ultimaFila >= 1 And ultimaCol >= 1 Then
ReDim cols(1 To ultimaCol)
For i = 1 To ultimaCol
cols(i) = i
Next i
On Error Resume Next
wsDestino.Range(wsDestino.Cells(1, 1), wsDestino.Cells(ultimaFila, ultimaCol)).RemoveDuplicates _
Columns:=cols, Header:=IIf(headerIsPresent, xlYes, xlNo)
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ErrHandler
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = 1
outRow = 1
If headerIsPresent Then
For i = 1 To ultimaCol
wsDestino.Cells(outRow, i).Value = wsDestino.Cells(1, i).Value
Next i
outRow = outRow + 1
End If
If headerIsPresent Then
Set rngToCheck = wsDestino.Range(wsDestino.Cells(2, 1), wsDestino.Cells(ultimaFila, ultimaCol))
Else
Set rngToCheck = wsDestino.Range(wsDestino.Cells(1, 1), wsDestino.Cells(ultimaFila, ultimaCol))
End If
For r = 1 To rngToCheck.Rows.Count
arrRow = Application.Index(rngToCheck.Value, r, 0)
key = ""
For i = LBound(arrRow) To UBound(arrRow)
key = key & "|||" & CStr(arrRow(i))
Next i
If Not dict.Exists(key) Then
dict.Add key, 1
For i = 1 To ultimaCol
wsDestino.Cells(outRow, i).Value = rngToCheck.Cells(r, i).Value
Next i
outRow = outRow + 1
End If
Next r
If outRow <= ultimaFila Then
wsDestino.Range(wsDestino.Cells(outRow, 1), wsDestino.Cells(ultimaFila, ultimaCol)).Clear
End If
Set dict = Nothing
Else
On Error GoTo ErrHandler
End If
End If
wsDestino.Columns.AutoFit
wsDestino.Activate
wsDestino.Range("A1").Select
Cleanup:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & "Linea aproximada: " & Erl, vbCritical
Resume Cleanup
End Sub
⭐ Si te gustó, por favor regístrate en nuestra Lista de correo y Suscríbete a mi canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.
