UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

chema


Hola a todos,

Tengo un problema ya que quiero crear una macro para que sobre una lista situada en la columna A, me elimine los datos duplicados, me los ordene alfabeticamente y sería perfecto si al cerrar el libro me ejecutara la macro. De momento he hecho la macro para eliminar datos duplicados (a continuación) la pongo pero no se seguir. Si alguien me pudiera ayudar se lo agradecería. Muchas gracias por vuestra ayuda.

Private Sub CommandButton1_Click()
Dim fila As Long
  With Application
         For fila = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
          If .WorksheetFunction.CountIf(Range("A:A"), _
              Cells(fila, 1)) > 1 Then Cells(fila, 1).EntireRow.Delete
      Next fila
       End With

End Sub

Nota: Tengo puesto la macro en un botón pero me gustaría que además se ejecutara siempre que se cierre el libro por si no se acuerda el usuario en darle al botón.

tyno


Hola chema.
Te paso un archivo de prueba con una macro que anda por internet la cual  he adaptado para quitar y ordenar los datos de un rango, en este caso para los datos de la columna A.
La macro se ejecuta con el botón de la Hoja 1 y para que dicha macro se ejecute al cerrar el libro deberías ir al editor de macros y en ThisWorkBook ingresar este código:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim rango As New Collection
Dim celda As Range
Dim dato
Application.ScreenUpdating = False

For Each celda In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
If celda <> "" Then rango.Add celda, CStr(celda)
Next celda
    
For i = 1 To rango.Count - 1
For j = i + 1 To rango.Count
If rango(i) > rango(j) Then
ref1 = rango(i)
ref2 = rango(j)
rango.Add ref1, before:=j
rango.Add ref2, before:=i
rango.Remove i + 1
rango.Remove j + 1
End If
Next j
Next i
    
x = 1
For Each dato In rango
Cells(x, 1) = dato
x = x + 1
Next dato
    
 
Range(Cells(x, 1), Cells(Cells(x, 1).End(xlDown).Row, 1)) = ""
 
Application.ScreenUpdating = False
End Sub



Saludos.
Archivos
prueba.zip
No tienes los permisos para descargar los archivos.
(11 KB)

chema


Hola Tyno,

Gracias por la ayuda, pero he visto que para palabras compuestas no funciona muy bien. Te paso un ejemplo con tu plantilla para que lo veas. He estado mirando pero no veo cual es el problema.

Gracias de nuevo.

Un saludo.
Archivos
prueba2.xls
No tienes los permisos para descargar los archivos.
(47 KB)

tyno


Hola chema.
He probado la macro con  las palabras compuestas que has pasado y aparentemente todo funciona bien, filtre los datos con una tabla dinámica para comparar los resultados de la macro y todo estaba Ok.
Lo que si me falto una instrucción para re-ordenar los datos al final.
Abajo te paso el código para que veas que linea agregar y donde agregarla,ya sea en ThisWorkBook o en el botón.  Saludos

On Error Resume Next
Dim rango As New Collection
Dim celda As Range
Dim dato
Application.ScreenUpdating = False

For Each celda In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
If celda <> "" Then rango.Add celda, CStr(celda)
Next celda
    
For i = 1 To rango.Count - 1
For j = i + 1 To rango.Count
If rango(i) > rango(j) Then
ref1 = rango(i)
ref2 = rango(j)
rango.Add ref1, before:=j
rango.Add ref2, before:=i
rango.Remove i + 1
rango.Remove j + 1
End If
Next j
Next i
    
x = 1
For Each dato In rango
Cells(x, 1) = dato
x = x + 1
Next dato
    
 
Range(Cells(x, 1), Cells(Cells(x, 1).End(xlDown).Row, 1)) = ""

Range("A:A").Sort key1:=[a1], order1:=xlAscending' <<<<<<AGREGAR ESTA LINEA
 
Application.ScreenUpdating = False

chema


Perfecto. Funciona estupendamente. 

Muchas gracias.

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.