Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » agregar funcion a macro concatenar

Excel - agregar funcion a macro concatenar

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 3
Ha aumentado su posición en 10 puestos en Excel (en relación al último mes)
Gráfica de Excel

agregar funcion a macro concatenar

Publicado por gonza (2 intervenciones) el 15/08/2018 00:32:11
hola buen día!!!
tengo esta macro que hace lo siguiente:

de dos columnas me cuenta las veces que se repite una llave en la primer columna, luego inserta una columna en medio para colocar el numero de veces que se repite la llave; y en la 3er columna me concatena los valores de esa llave. Por ej. si la llave existe 3 veces en la celda de enfrente me pone el numero 3 y en la celda de en seguida concatena los valores de la llave.

idPerson Edad
567 25
567 18
567 45

despues de correr la macro el resultado es:

idPersona #veces ConcatenarValores
567 3 25, 18, 45

Esto funciona para dos columnas de datos. Me podrian ayudar a agregrale lo ncesario a la macro para que me concatene los valores de mas de una columna; en caso de de tener mas columnas como el Sexo de la persona, estado civil, escolaridad...etc al correr la macro me concatene todas las columnas.
porque asi como esta tengo que correr la macro de manera individual para la edad, luego copio el resultado; luego la corro para el sexo de la persona; luego para el esatdo civil de la persona.......por separado.

adjunto un archivo ejemplo con los datos a concatenar y la macro en cuestion
slds!!!
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

agregar funcion a macro concatenar

Publicado por Antoni Masana (2485 intervenciones) el 16/08/2018 12:10:51
No entiendo la explicación de lo que estas concatenando.

Mirando el resultado de la ejecución veo que concatenas las celdas de la Edad para una misma llave.

Veo varios errores:

- Ordenas SOLO las columnas A y B ¿Y el resto de columna?
- Empieza en la fila 1 y debería empezar en la fila 2
- Cada vez que concatenas desplazas los datos de la fila,
--- Si concatenas 2 filas pierde el Sexo.
--- Si concatenas 3 filas pierde el Sexo y Estado Civil.
--- Si concatenas 4 filas pierde el Sexo, Estado Civil y Escolaridad.
--- etc.

Creo que deberías Tomar las Columnas de la A a la H y ordenar por las A y B y escribir el resultado en otra hoja u otro libro, porque el resto de columnas no son representativas a la fila resultante.

Quieres una macro que te concatene todas las columnas, bien es facil, lo que no le encuentro es el sentido pero eso es lo de menos

Creo que la macro es un poco complicada, además del echo de no tener ni un solo comentario.

En el libro PRUEBA ejecuta esta macro. Crea una segunda hoja que llama Resumen y deja allí el resultado

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
 
Sub Concatenar_Todo()
    Dim Hoja_Orig As String, Fila_Orig As Long, _
        Hoja_Dest As String, Fila_Dest As Long
 
    Hoja_Orig = "Hoja1"
    Hoja_Dest = "Resumen"
 
    ' ---&--- Añade una hoja para el resumen

 
    If Sheets.Count = 1 Then
       Sheets.Add After:=Sheets(Sheets.Count)
       Sheets(ActiveSheet.Name).Select
       Sheets(ActiveSheet.Name).Name = Hoja_Dest
    End If
 
    ' ---&--- Selecciono la hoja e datos

 
    Sheets(Hoja_Orig).Select
 
    ' ---&--- Ordena por llave y Edad

 
    Columns("A:G").Select
    ActiveWorkbook.Worksheets(Hoja_Orig).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(Hoja_Orig).Sort.SortFields.Add _
                                         Key:=Range("A:A"), _
                                         SortOn:=xlSortOnValues, _
                                         Order:=xlAscending, _
                                         DataOption:=xlSortNormal
 
    ActiveWorkbook.Worksheets(Hoja_Orig).Sort.SortFields.Add _
                                         Key:=Range("B:B"), _
                                         SortOn:=xlSortOnValues, _
                                         Order:=xlAscending, _
                                         DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets(Hoja_Orig).Sort
        .SetRange Range("A:G")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    ' ---& Empiezo a agrupar

 
    Fila_Orig = 2
    Fila_Dest = 1
 
    While Cells(Fila_Orig, "A") <> "" ' ---&--- Mientras hay datos en la columna A

 
        If Cells(Fila_Orig, "A") <> Cells(Fila_Orig - 1, "A") Then
 
           ' ---&---  Si es diferente al anterior añade una linea en el destino

           '          El primero siempre sera diferenta al anterior

 
           Fila_Dest = Fila_Dest + 1
           With Sheets(Hoja_Dest)
               .Cells(Fila_Dest, "A") = Cells(Fila_Orig, "A")
               .Cells(Fila_Dest, "B") = 1
               .Cells(Fila_Dest, "C") = Cells(Fila_Orig, "B")
               .Cells(Fila_Dest, "D") = Cells(Fila_Orig, "C")
               .Cells(Fila_Dest, "E") = Cells(Fila_Orig, "D")
               .Cells(Fila_Dest, "F") = Cells(Fila_Orig, "E")
               .Cells(Fila_Dest, "G") = Cells(Fila_Orig, "F")
               .Cells(Fila_Dest, "H") = Cells(Fila_Orig, "G")
           End With
 
        Else ' ---&--- Es igual al anterior lo añade al anterior en el destino

 
           With Sheets(Hoja_Dest)
               .Cells(Fila_Dest, "B") = .Cells(Fila_Dest, "B") + 1
               .Cells(Fila_Dest, "C") = .Cells(Fila_Dest, "C") & ", " & Cells(Fila_Orig, "B")
               .Cells(Fila_Dest, "D") = .Cells(Fila_Dest, "D") & ", " & Cells(Fila_Orig, "C")
               .Cells(Fila_Dest, "E") = .Cells(Fila_Dest, "E") & ", " & Cells(Fila_Orig, "D")
               .Cells(Fila_Dest, "F") = .Cells(Fila_Dest, "F") & ", " & Cells(Fila_Orig, "E")
               .Cells(Fila_Dest, "G") = .Cells(Fila_Dest, "G") & ", " & Cells(Fila_Orig, "F")
               .Cells(Fila_Dest, "H") = .Cells(Fila_Dest, "H") & ", " & Cells(Fila_Orig, "G")
           End With
        End If
        Fila_Orig = Fila_Orig + 1
    Wend
 
    ' ---&--- Lineas grabadas

 
    Fila_Dest = Fila_Dest + 1
    Sheets(Hoja_Dest).Cells(Fila_Dest, "A") = Fila_Dest
 
    MsgBox "Fin de la Macro"
End Sub

Aquí es más fácil añadir o quitar columnas a concatenar.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 3
Ha aumentado su posición en 10 puestos en Excel (en relación al último mes)
Gráfica de Excel

agregar funcion a macro concatenar

Publicado por gonza (2 intervenciones) el 16/08/2018 23:38:57
excelente!!!! ya hice la prueba y si funcionó correctamente.

muchas gracias!!!! slds!!!!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar