Excel - CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

 
Vista:
sin imagen de perfil
Val: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 23/02/2020 23:47:35
Intento desarrollar un excel que me permita obtener 2 sistemas distintos de CONCATENAR CELDAS a través de un 'Useform'.
Podríamos decir que los sistemas se resumen en un botón 'TODO' y un botón 'SELECCIONADOS', pero no acierto a conseguir el efecto buscado.

Trataré de explicarme.

>> Boton 'TODO' tiene como finalidad que:
1. En base a todas la celdas con información en la columna C, sea capaz de concatenar las columnas B+C+D + Salto de Linea (con =CARACTER(10)) y mostrarlo en el TextBox1 de la 'UserForm'
2. Que las palabras 'Dado o dado', 'Cuando o cuando', 'Entonces o entonces' aparezcan en el 'TexBox1' como *DADO*, *CUANDO* y *ENTONCES*. Ahora mismo consigo que estos cambios de produzcan en el propio excel ,pero no el 'TexBoX1' de la Userform
>> Boton 'SELECCIONADOS' tiene como finalidad que:
1. Previa selección con el ratón de varias celdas, me genere exactamente la concatenación de las celdas con SALTOS DE LINEA (con =CARACTER(10)).
Ahora mismo me funciona, pero he tenido que meter un =CARACTER(10) falso en columna E junto la palabra | Para plantear |.
Seguro que existe una forma de decirle que cuando en la columna D encuentre '| Para plantear |' realice el SALTO DE LINEA (=CARACTER(10)).
2. Que las palabras 'Dado o dado', 'Cuando o cuando', 'Entonces o entonces' aparezcan en el 'TexBox1' como *DADO*, *CUANDO* y *ENTONCES*. Ahora mismo consigo que estos cambios de produzcan en el propio excel ,pero no el 'TexBoX1' de la Userform

>> 3. Botón 'EXPORTAR TXT', en el que me gustaría que el contenido del TextBox1 (sea mediante el botón TODO o SELECCIONADOS) con las palabras reemplazadas, pueda ser exportado a *.txt.
He encontrado argumentos para exportar a TXT, pero no se indicarle que sea el contenido del TextBox1 tal no es mostrado.

>> 4. Botón 'PORTAPAPELES', en el que me gustaría que el contenido del TextBox1 (sea mediante el botón TODO o SELECCIONADOS) pueda ser almacenado en el ¡Portapapeles' para luego poder pegarlo dónde yo quiera.
He leído algunos ejemplos de código vba con la función ClipBoard_SetData en el que una vez ejecutado, solo basta presionar el [Ctrl] + [V] para pegar los datos dónde yo quiera, pero la macro que he visto me ha precido muy compleja para mi nivel y no soy capaz de retocarla para lo que yo quiero hacer. :-(

En fin quizá pido algo muy complejo, pero por lo menos me interesaría obtener ayuda para las modalidades de CONCATENAR y (=CARACTER(10))
Os adjunto un excel para que podás ver por dónde va la cosa.
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

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Antoni Masana (2477 intervenciones) el 24/02/2020 15:29:02
Te pongo el código modificado de los dos primeros botones.

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Private Sub CommandButton1_Click()
    ActiveSheet.Select  'Activas la hoja donde están los datos.
    Dim Celda As Range, cText As String, Fila As Long, Salto As Byte
 
    Fila = 5
    Salto = 1
    While Cells(Fila, "C") <> ""
        cText = cText + Cells(Fila, "C")
        If Salto = 3 Then Salto = 0: cText = cText + vbCrLf
        Salto = Salto + 1
        Fila = Fila + 1
    Wend
 
    Me.TextBox1 = Mid(cText, 1, Len(cText) - 4)
    Call Reemplaza
End Sub
 
Private Sub CommandButton2_Click()
    ActiveSheet.Select  'Activas la hoja donde están los datos.
    Dim Celda As Range, cText$, Salto As Byte
 
    'Si es seleccionando las celdas con el ratón:
 
    Salto = 1
    For Each Celda In Selection
        cText = cText & Celda
        If InStr(LCase(Celda), LCase("Entonces")) > 0 Then
            Salto = 0: cText = cText + vbCrLf
        End If
        Salto = Salto + 1
    Next Celda
 
    Me.TextBox1 = Mid(cText, 1, Len(cText) - 4)
    Call Reemplaza
End Sub
 
Sub Reemplaza()
    Cells.Replace What:="Dado", _
                  Replacement:="DADO", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="dado", _
                  Replacement:="DADO", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="DADO ", _
                  Replacement:="*DADO*", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="Cuando", _
                  Replacement:="CUANDO", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="cuando", _
                  Replacement:="CUANDO", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="CUANDO ", _
                  Replacement:="*CUANDO*", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="Entonces", _
                  Replacement:="ENTONCES", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="entonces", _
                  Replacement:="ENTONCES", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
 
    Cells.Replace What:="ENTONCES ", _
                  Replacement:="*ENTONCES*", _
                  LookAt:=xlPart, _
                  SearchOrder:=xlByRows, _
                  MatchCase:=False, _
                  SearchFormat:=False, _
                  ReplaceFormat:=False
End Sub

En los reemplace para poner el asterico hay que poner un espacio después de la palabra porque de lo contrario el resultado es este después de varias ejecuciones:

1
****DADO**** un señor mayor sentado en un banco


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: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 24/02/2020 18:45:24
Hola Antonio,
lo primero de todo, agradecerte tu revisión sobre los 2 métodos de CONCATENAR.

No obstante, creo que no hace exactamente lo que ando buscando.
Trato de explicarme.

1. En el caso del botón TODO:
En base a la información de la columna C y desde la fila 4 (incluida) necesito que haga la concatenación DE TODO lo que encuentre en esa misma columna, teniendo en cuenta que cada grupo consta de 3 filas:

Fila 1 = Valor celda B (que empieza con un número |1|) + valor celda C + valor celda D (salto de linea con =CARACTER(10) )
Fila 2 = Valor celda B (esta vacia) + valor celda C + valor celda D (salto de linea con =CARACTER(10) )
Fila 3 = Valor celda B (esta vacia) + valor celda C + valor celda D (|Para plantear|) + salto de linea con =CARACTER(10)

2. En el caso del botón SELECCIONADO:
Pues sería el mismo planteamiento, salvo que lo que concatenar ha sido previamente seleccionado con el ratón, aunque la filosofía es la misma

3. Las PALABRAS que deben reemplazaerse, pensaba que conseguiría que el 'TexBox1' las mostrara con el asterisco (*)....
¡No es necesario que se modifiquen en las celdas excel...pero tampoco pasa nada si lo hacen.

Lo que ando buscando, es que por ambos procedimientos consiga algo de este estilo (añadiendo el número, frases, saltos de linea y |Para plantear|)

Ej:

|1|*DADO*un señor mayor sentado en un banco
*CUANDO* el señor siente sed
*ENTONCES* ira a beber agua de la fuente |Para plantear|
|2|*DADO* un señor mayor sentado en un banco con una chaqueta a su lado
*CUANDO* el señor tenga frio
*ENTONCES* se pondrá una chaqueta|Para plantear|
|3|*DADO* un señor mayor sentado en un banco con manzana a su lado
*CUANDO* el señor tenga hambre
*ENTONCES* comerá la manzana |Para plantear|

Muchas gracias de antemano.
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
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

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Antoni Masana (2477 intervenciones) el 24/02/2020 19:41:55
Solo hay que hacer unos pequeños cambios:

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
Private Sub CommandButton1_Click()
    ActiveSheet.Select  'Activas la hoja donde están los datos.
    Dim Celda As Range, cText As String, Fila As Long
 
    Fila = 5
    While Cells(Fila, "C") <> ""
        cText = cText + Cells(Fila, "B") + Cells(Fila, "C") + Cells(Fila, "D")
        If Right(cText, 1) <> Chr(10) Then cText = cText + "   " + Chr(10)
        Fila = Fila + 1
    Wend
 
    Me.TextBox1 = Mid(cText, 1, Len(cText) - 4)
    Call Reemplaza
End Sub
 
Private Sub CommandButton2_Click()
    ActiveSheet.Select  'Activas la hoja donde están los datos.
    Dim Celda As Range, cText$
 
    'Si es seleccionando las celdas con el ratón:
 
    For Each Celda In Selection
        Celda.Select
        cText = cText + ActiveCell.Offset(0, -1) + Celda + ActiveCell.Offset(0, 1)
        If Right(cText, 1) <> Chr(10) Then cText = cText + "   " & Chr(10)
    Next Celda
 
    Me.TextBox1 = Mid(cText, 1, Len(cText) - 4)
    Call Reemplaza
End Sub

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: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 24/02/2020 22:32:08
¡¡Está perfecto Antonio!!
Muchas gracias.
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
sin imagen de perfil
Val: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 25/02/2020 06:24:39
Buenos dias,
respecto a que el contenido del 'TexBox1' concatenado por cualquiera de los métodos, se pueda enviar al PORTAPAPELES para despues pegarlo dónde nos plazca, no he terminado de encontrar el método que lo haga, todo y que he probado muchas formas....

Ahora mismo he probado este que le indica que el contenido del 'TexBox1 se ponga en el portapaples....
¡Pero luego no me pega el contenido!


1
2
3
4
5
6
7
8
Private Sub CommandButton4_Click()
    With New MSForms.DataObject
        .SetText TextBox1.Text
        .PutInClipboard
    End With
 
 MsgBox "Se ha copiado el texto al portapapeles", vbInformation
End Sub
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
sin imagen de perfil
Val: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 25/02/2020 17:27:38
Hola Antoni.

Lo he probado, pero a mi no me funciona :-(

Si en teoría, al ejecutar la macro, debería almacenar todo el contenido del 'TextBox1' en el portapapeles, y al hacer luego un Ctrol+V debería poder pegarlo en un 'Word' o 'Notepad' u otro programa......¡Pero no me lo hace!!

¿Tú si puedes pegar la información capturada en el portapales?
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
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

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Antoni Masana (2477 intervenciones) el 25/02/2020 17:54:31
Te adjunto el libro.
Lo he vuelto a probar y me sigue funcionando.
Incluye los cambios de los dos primeros botones.

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: 179
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Quico (106 intervenciones) el 25/02/2020 20:42:45
Hola Antonio, pues lo acabo de probar y nada de nada....pero no tengo ni idea del motivo.
¿La version de excel? La mía es EXCEL 2016

Por lo demás.....no se que puede hacer que a mi no me guarde la información en el portapapeles de 'Windows'
:-(
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
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

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por María Rosa (1 intervención) el 01/03/2021 23:42:59
Hola Antoni,
Estoy creando una macro para concatenar celdas con formato y fuentes, se trata que concatene el contenido pero me es necesario que respete las fuentes, (color, negrita, Mayús, etc.) Concatena bien todos los rangos, pero no respeta los colores de fuente y no logro dar con el conflicto.
Copio el modulo en el cual estoy trabajando, si puedes echarme una mano, te lo agradecería o si tienes algún otro código también me valdría.
Gracias

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
Sub ConcatenarVariasCeldasConFormato()
Application.ScreenUpdating = False
Dim Celda As Range
For Each Celda In Range("C5:C370")
With Celda
.Value = .Offset(, 1) & " " & .Offset(, 2) & " " & .Offset(, 3) & " " & .Offset(, 4) & " " & .Offset(, 5)
With .Characters(1,Len(.Offset(, 1))).Font
.ColorIndex = Celda.Offset(, 1).Font.ColorIndex
.Bold = Celda.Offset(, 1).Font.Bold
.Italic = Celda.Offset(, 1).Font.Italic
.Name = Celda.Offset(, 1).Font.Name
.Size = Celda.Offset(, 1).Font.Size
.Underline = Celda.Offset(, 1).Font.Underline
End With
With .Characters(Len(.Offset(, 1)) + 2, Len(.Offset(, 2))).Font
.ColorIndex = Celda.Offset(, 2).Font.ColorIndex
.Bold = Celda.Offset(, 2).Font.Bold
.Italic = Celda.Offset(, 2).Font.Italic
.Name = Celda.Offset(, 2).Font.Name
.Size = Celda.Offset(, 2).Font.Size
.Underline = Celda.Offset(, 2).Font.Underline
End With
With .Characters(Len(.Offset(, 2)) + 3, Len(.Offset(, 3))).Font
.ColorIndex = Celda.Offset(, 3).Font.ColorIndex
.Bold = Celda.Offset(, 3).Font.Bold
.Italic = Celda.Offset(, 3).Font.Italic
.Name = Celda.Offset(, 3).Font.Name
.Size = Celda.Offset(, 3).Font.Size
.Underline = Celda.Offset(, 3).Font.Underline
End With
With .Characters(Len(.Offset(, 3)) + 4, Len(.Offset(, 4))).Font
.ColorIndex = Celda.Offset(, 4).Font.ColorIndex
.Bold = Celda.Offset(, 4).Font.Bold
.Italic = Celda.Offset(, 4).Font.Italic
.Name = Celda.Offset(, 4).Font.Name
.Size = Celda.Offset(, 4).Font.Size
.Underline = Celda.Offset(, 4).Font.Underline
End With
With .Characters(Len(.Offset(, 1) & .Offset(, 2) & .Offset(, 3) & .Offset(, 4)) + 5, Len(.Offset(, 5))).Font
.ColorIndex = Celda.Offset(, 5).Font.ColorIndex
.Bold = Celda.Offset(, 5).Font.Bold
.Italic = Celda.Offset(, 5).Font.Italic
.Name = Celda.Offset(, 5).Font.Name
.Size = Celda.Offset(, 5).Font.Size
.Underline = Celda.Offset(, 5).Font.Underline
End With
End With
Next
End Sub
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
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

CONCATENAR DE 2 MANERAS DIFERENTES A TRAVES DE UN USEFORM

Publicado por Antoni Masana (2477 intervenciones) el 02/03/2021 16:01:21
Buenas Maria Rosa,

Es mejor que abras un nuevo mensaje donde expliques el problema, además si adjuntas el fichero podemos ver que hace la macro y donde falla o donde se puede mejorar.

Tambien puedes enviarlo a mi correo si lo prefieres: [email protected]

Por otro lado el código se lee mejor asi:

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
Sub ConcatenarVariasCeldasConFormato()
    Application.ScreenUpdating = False
    Dim Celda As Range
    For Each Celda In Range("C5:C370")
        With Celda
                .Value = .Offset(, 1) & " " & .Offset(, 2) & " " & .Offset(, 3) & " " & .Offset(, 4) & " " & .Offset(, 5)
            With .Characters(1,Len(.Offset(, 1))).Font
                .ColorIndex = Celda.Offset(, 1).Font.ColorIndex
                .Bold = Celda.Offset(, 1).Font.Bold
                .Italic = Celda.Offset(, 1).Font.Italic
                .Name = Celda.Offset(, 1).Font.Name
                .Size = Celda.Offset(, 1).Font.Size
                .Underline = Celda.Offset(, 1).Font.Underline
            End With
            With .Characters(Len(.Offset(, 1)) + 2, Len(.Offset(, 2))).Font
                .ColorIndex = Celda.Offset(, 2).Font.ColorIndex
                .Bold = Celda.Offset(, 2).Font.Bold
                .Italic = Celda.Offset(, 2).Font.Italic
                .Name = Celda.Offset(, 2).Font.Name
                .Size = Celda.Offset(, 2).Font.Size
                .Underline = Celda.Offset(, 2).Font.Underline
            End With
            With .Characters(Len(.Offset(, 2)) + 3, Len(.Offset(, 3))).Font
                .ColorIndex = Celda.Offset(, 3).Font.ColorIndex
                .Bold = Celda.Offset(, 3).Font.Bold
                .Italic = Celda.Offset(, 3).Font.Italic
                .Name = Celda.Offset(, 3).Font.Name
                .Size = Celda.Offset(, 3).Font.Size
                .Underline = Celda.Offset(, 3).Font.Underline
            End With
            With .Characters(Len(.Offset(, 3)) + 4, Len(.Offset(, 4))).Font
                .ColorIndex = Celda.Offset(, 4).Font.ColorIndex
                .Bold = Celda.Offset(, 4).Font.Bold
                .Italic = Celda.Offset(, 4).Font.Italic
                .Name = Celda.Offset(, 4).Font.Name
                .Size = Celda.Offset(, 4).Font.Size
                .Underline = Celda.Offset(, 4).Font.Underline
            End With
            With .Characters(Len(.Offset(, 1) & .Offset(, 2) & .Offset(, 3) & .Offset(, 4)) + 5, Len(.Offset(, 5))).Font
                .ColorIndex = Celda.Offset(, 5).Font.ColorIndex
                .Bold = Celda.Offset(, 5).Font.Bold
                .Italic = Celda.Offset(, 5).Font.Italic
                .Name = Celda.Offset(, 5).Font.Name
                .Size = Celda.Offset(, 5).Font.Size
                .Underline = Celda.Offset(, 5).Font.Underline
            End With
        End With
    Next
End Sub

Saludos.
\\//_
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