Sección de códigos, trucos y ejemplos para visual basic

Clic para descargar Velneo Open source Software - Plataforma para el desarrollo de aplicaciones sobre base de datos

425 - Eliminar valores duplicados en Excel

Rutina que recorre las celdas de una columna determinada, para buscar y eliminar los valores repetidos

El ejemplo tiene una rutina a la cual se le pasa como argumentos el path del libro, el número de columna a verificar, y la fila inicial y la fila final en la que buscará los valores duplicados

por ejemplo esto recorre desde la fila 10 hasta la fila 20 en la columna 1

Call Eliminar_Duplicados_PorColumna("c:\libro1.xls", 1, 10, 20)

Para el ejemplo colocar

un control commandbutton
la referencia Excel
y especificar la ruta del archivo xls

Código fuente en el formulario

Option Explicit Private Sub Chequear_Valores(sElementos() As Variant) Dim TempArray() As String Dim x As Integer, x2 As Integer, y As Integer Dim z As Integer, Elemento As Variant Dim ArrFinal() As Variant Dim nRedim As Long Dim i As Integer For i = LBound(sElementos) To UBound(sElementos) ReDim Preserve TempArray(i) TempArray(i) = sElementos(i) Next For x = 0 To UBound(sElementos) z = 0 For y = 0 To UBound(sElementos) If sElementos(x) = TempArray(z) And y <> x Then sElementos(y) = "" nRedim = nRedim + 1 End If z = z + 1 Next y Next x i = 0 ReDim ArrFinal(0) For Each Elemento In sElementos If Elemento <> "" Then ' agrega los elementos ArrFinal(i) = Elemento i = i + 1 ReDim Preserve ArrFinal(i) End If Next ' retorna la lista sElementos = ArrFinal End Sub Private Sub Eliminar_Duplicados_PorColumna(PathXLS As String, _ Columna As Long, _ DesdeFila As Long, _ HastaFila) Dim objExcel As Excel.Application Dim Elementos() As Variant Set objExcel = New Excel.Application ' abre el xls objExcel.Workbooks.Open (PathXLS) ReDim Elementos(0) Me.MousePointer = vbHourglass With objExcel.ActiveWorkbook.Sheets(1) Dim fila As Long Dim n As Long n = 1 ' recorre desde el rango de fila For fila = DesdeFila To HastaFila ' almacena los datos a verificar Elementos(n - 1) = .Application.Cells(fila, Columna) ' elimina el valor de la celda .Application.Cells(fila, Columna) = "" ReDim Preserve Elementos(UBound(Elementos) + 1) n = n + 1 Next ' llama al rutina para verificar los valores repetidos Chequear_Valores Elementos Dim fActual As Long n = 0 ' recorre la lista de los elementos para asignarlos a las celdas For n = 0 To UBound(Elementos) - 1 .Application.Cells((DesdeFila + fActual), Columna).Value = Elementos(n) fActual = fActual + 1 Next End With ' guarda los cambios del libro objExcel.ActiveWorkbook.Save objExcel.Quit Set objExcel = Nothing Me.MousePointer = vbNormal End Sub Private Sub Command1_Click() 'pasa el libro, el número de la columna _ a verificar, la fila inicial, y la fina final Call Eliminar_Duplicados_PorColumna("c:\libro1.xls", 1, 5, 250) End Sub

Recursos vb 6.0 - Enlaces relacionados

Recursos vb.NET - Enlaces relacionados

Eliminar duplicados en control ListBox de visual basic.NET

Buscar en Recursos vb