Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Texto a filas desde una celda

Excel - Texto a filas desde una celda

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Texto a filas desde una celda

Publicado por Yisus (4 intervenciones) el 18/04/2018 03:05:53
Hola tengo una data algo asi

Celda A1
Carlos Perez
Celda B1
Break 04/17/2018 9:45 AM-04/17/2018 10:00 AM;"Lunch" 04/17/2018 11:45 AM-04/17/2018 12:15 PM;"Break" 04/17/2018 2:15 PM-04/17/2018 2:30 PM;

y me gustaria deplegar la data en la cual separe cada evento y le asigne el mismo nombre por ejemplo:

Columna A - Columna B
Carlos Perez - Break 04/17/2018 9:45 AM-04/17/2018 10:00 AM
Carlos Perez - Lunch" 04/17/2018 11:45 AM-04/17/2018 12:15 PM
Carlos Perez - "Break" 04/17/2018 2:15 PM-04/17/2018 2:30 PM
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

Texto a filas desde una celda

Publicado por Antoni Masana (2480 intervenciones) el 18/04/2018 12:45:09
En principio la macro podría ser esí

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
Sub Macro1()
    Selection.TextToColumns Destination:=Range("B1"), _
                            DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, _
                            ConsecutiveDelimiter:=False, _
                            Tab:=False, _
                            Semicolon:=True, _
                            Comma:=False, _
                            Space:=False, _
                            Other:=False, _
                            FieldInfo:=Array(Array(1, 1), Array(2, 1), _
                                             Array(3, 1), Array(4, 1)), _
                            TrailingMinusNumbers:=True
 
    ActiveSheet.PasteSpecial Format:="Texto Unicode", _
                             Link:=False, _
                             DisplayAsIcon:=False
    Range("B1:D1").Select
    Selection.Copy
 
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
                           Operation:=xlNone, SkipBlanks:= _
                           False, Transpose:=True
 
    Range("A1").Select:    Selection.Copy
    Range("A4:A6").Select: ActiveSheet.Paste
 
    Application.CutCopyMode = False
End Sub

Si la cosa se puede complicar un poquito más. Pero deberias subir un ejemplo y ampliar la explicación

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
sin imagen de perfil

Texto a filas desde una celda

Publicado por Yisus (4 intervenciones) el 19/04/2018 02:48:27
gracias por la respuesta, estoy buscando algo un poco diferente, adjunto un archivo con lo ejemplos y el codigo con el que ya cuento.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub SplistText()
Dim TextString As String, WArray() As String, Counter As Integer, Strg As String
 
    TextString = Range("A1").Value
    WArray() = Split(TextString, ";")
 
    For Counter = LBound(WArray) To UBound(WArray)
 
    Strg = WArray(Counter)
    Cells(Counter + 3, 1).Value = Trim(Strg)
 
    Next Counter
 
End Sub

de antemano 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
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

Texto a filas desde una celda

Publicado por Antoni Masana (2480 intervenciones) el 19/04/2018 10:45:52
Prueba es Macro

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Macro()
    Dim Fila_Orig As Integer, Nombre As String, Pun As Integer, _
        Fila_Dest As Integer, Exce() As String
 
    Fila_Orig = 1
    Fila_Dest = 1: Sheets("Data").Select
 
    While Sheets("Data").Cells(Fila_Orig, 1) <> ""
        Nombre = Sheets("Data").Cells(Fila_Orig, 1)
        Exce() = Split(Sheets("Data").Cells(Fila_Orig, 2), ";")
 
        For Punt = LBound(Exce) To UBound(Exce)
            If Len(Exce(Punt)) > 0 Then
                Fila_Dest = Fila_Dest + 1
                Sheets("Final Data").Cells(Fila_Dest, 1) = Nombre
                Sheets("Final Data").Cells(Fila_Dest, 2) = Exce(Punt)
                Exce(Punt) = ""
            End If
        Next
        Fila_Orig = Fila_Orig + 1
    Wend
    Sheets("Final Data").Select
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
sin imagen de perfil

Texto a filas desde una celda

Publicado por Yisus (4 intervenciones) el 21/04/2018 19:25:20
Muchas gracias por la ayuda Antoni, me sirvio muchisimo...

pongo el codigo completo hasta donde llevo por si a alguien mas le sirve espero mejorarlo, adjunto mi archivo.

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
Sub Macro()
 
    Dim Fila_Orig As Integer, Nombre As String, Pun As Integer, _
    Fila_Dest As Integer, Exce() As String, LValue As String
 
    Columns("A:F").Select
    Selection.AutoFilter
    Range("A2").Select
    Selection.ClearContents
    Range("A1").Select
    ActiveSheet.Range("A:F").AutoFilter Field:=1, Criteria1:="="
    Range("A:F").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    Range("B1").Select
    Range("B1").Value = "=concatenate(F1,E1)"
    ActiveCell.Copy
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.PasteSpecial (xlPasteFormulas)
    Selection.Copy
    Selection.PasteSpecial (xlPasteValues)
    Range("C:F").Select
    Selection.EntireColumn.Delete
    Range("A1").Select
 
    Fila_Orig = 1
    Fila_Dest = 1: Sheets("Data").Select
 
    While Sheets("Data").Cells(Fila_Orig, 1) <> ""
        Nombre = Sheets("Data").Cells(Fila_Orig, 1)
        Exce() = Split(Sheets("Data").Cells(Fila_Orig, 2), ";")
 
        For Punt = LBound(Exce) To UBound(Exce)
            If Len(Exce(Punt)) > 0 Then
                Fila_Dest = Fila_Dest + 1
                Sheets("Final Data").Cells(Fila_Dest, 1) = Nombre
                Sheets("Final Data").Cells(Fila_Dest, 2) = Exce(Punt)
                Exce(Punt) = ""
            End If
        Next
        Fila_Orig = Fila_Orig + 1
    Wend
    Sheets("Final Data").Select
    Range("C1:G1").Select
    Selection.Copy
    Range("B2").Select
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Offset(0, 1).Activate
    Selection.PasteSpecial (xlPasteFormulas)
    Selection.Copy
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    Range("A1").Select
 
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