Macro extrae cadenas de texto o string: Mid, Len …

Esta macro de Excel íntegramente programada  en VBA muestra como trabajar con cadenas de texto, como siempre el ejemplo de macro se puede bajar en forma gratuita. En el archivo se muestra como se puede a través de macros como se puede modificar cadenas de texto o string, en primer lugar este procedimiento de VBA crea  los encabezados de las columnas, terminado esto realiza un bucle mientras las filas no estén vacías, es decir mientras tengan datos, trabajando en cada fila con textos o string, para ello en la columa A se usa la función StrReverse, que lo que hace es dar vuelta la cadena de texto, en este caso es a los fines de extraer el texto que se encuentra a la derecha del espacio, para saber en que ubicación se encuentra el espació se usa InStr y por último con la  expresión Right se obtiene lo que está a la derecha del espacio, posteriormente se vuelve a dar vuelta la cadena  de texto  y de esta manera se obtuvo el string que se quería obtener, eso se hace con las columas A. En la columna B se hace algo parecido, pero a su vez se usa la función WorksheetFunction.Proper, que lo que hace es darle formato de titulo al texto.

Una vez que se han obtenido las cadenas de texto en la forma que se necesitan, se procede a ordenar para ello se determina la última fila con datos  y en base a ello se obtiene el rango a ordenar, por último formato a las filas.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El código que se encuentra a continuación se debe ingresar en un  módulo, descargando el ejemplo, desde el link del final, lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.

Código a insertar en módulo

Sub Format()
Application.ScreenUpdating = False
Dim fila As Integer
Dim r As Range
Dim r1, r2, r3 As String
‘starts the loop on row 2
fila = 2
‘column headings
Sheets(“sheet1”).Cells(1, 1) = “CostCenter”
Sheets(“sheet1”).Cells(1, 2) = “Participant’sName”
Sheets(“sheet1”).Cells(1, 3) = “Job Name”
Sheets(“sheet1”).Cells(1, 4) = “ComplDate”
Sheets(“sheet1”).Cells(1, 5) = “TRNG”
‘loop until the last row with data
While Sheets(“Sheet1”).Cells(fila, 1) <> Empty
‘working with string to remove characters requiredin Column 2
cad1 = Sheets(“Sheet1”).Cells(fila, 1)
lar1 = Len(cad1)
rev = StrReverse(cad1)
esp1 = InStr(rev, ” “)
cad1 = Right(rev, (lar1 – esp1))
cad1 = StrReverse(cad1)
‘assemble the cell name with the characters extracted
Sheets(“Sheet1”).Cells(fila, 1) = cad1
‘Function.Proper to the cell
Sheets(“Sheet1”).Cells(fila, 1) = WorksheetFunction.Proper(Sheets(“Sheet1”).Cells(fila, 1))
‘working with string to remove characters required in Column 2
cad2 = Sheets(“Sheet1”).Cells(fila, 2)
lar2 = Len(cad2)
esp2 = InStr(cad2, ” “)
cadape2 = Left(cad2, (lar2 – (lar2 – esp2 + 1)))
cadnom2 = Right(cad2, (lar2 – esp2))
‘assemble the cell name with the characters extracted
Sheets(“Sheet1”).Cells(fila, 2) = cadape2 & “, ” & cadnom2
‘Function.Proper to the cell
Sheets(“Sheet1”).Cells(fila, 2) = WorksheetFunction.Proper(Sheets(“Sheet1”).Cells(fila, 2))
‘Function.Proper to the cell
Sheets(“Sheet1”).Cells(fila, 3) = WorksheetFunction.Proper(Sheets(“Sheet1”).Cells(fila, 3))
Sheets(“Sheet1”).Cells(fila, 5) = “OSHA”
‘adds a cell to move to the next and to the end of data cells
fila = fila + 1
‘next and to the end of data cells
Wend
‘determines last row with data
uf = Sheets(“Sheet1”).Range(“A” & Rows.Count).End(xlUp).Row
‘will help determine ranges to sort data
r1 = “A2” & “:A” & uf
r2 = “B2” & “:B” & uf
r3 = “A1” & “:E” & uf

‘sorts the data
 ActiveWorkbook.Worksheets(“Sheet1”).Sort.SortFields.Clear
 ActiveWorkbook.Worksheets(“Sheet1”).Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets(“Sheet1”).Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets(“Sheet1”).Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

 ‘formats applied
 Range(“A1”).Select
 Range(Selection, Selection.End(xlToRight)).Select
   
        Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range(“A1”).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
   
    Columns(“A:A”).EntireColumn.AutoFit
    Columns(“B:B”).EntireColumn.AutoFit
    Columns(“C:C”).EntireColumn.AutoFit
    Columns(“D:D”).EntireColumn.AutoFit
    Columns(“E:E”).EntireColumn.AutoFit
Application.CutCopyMode = False
Range(“A1”).Select
Application.ScreenUpdating = True
End Sub

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends