macro for Multiline text in cell to truncate

时间:2017-04-09 23:39:19

标签: excel-vba vba excel

I have a multiline text in cell of specific column which has numbers followed by tab delimiter, i wish to work on below file please see name of SHEET

LINK TO FILE

actual data runs into more than 1000 rows, want to generate result output 1 and 2 in newly inserted column.

can any one help me with macro to run on specific column "ABC" and only keep text which is before tab and another column with two next character text concatenated. further this ABC column can change position in excel sheet I will be highly obliged if someone could help me.

Code I am Struck With is

Sub RahulSplit()
Dim colNum As Integer
    colNum = ActiveSheet.rows(1).Find(what:="ABC", lookat:=xlWhole).Column
        ActiveSheet.Columns(colNum + 1).Insert
        ActiveSheet.Cells(1, colNum + 1).Value = "Results 2 Anticipated"

    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "\w*\t\w*\s"
        Dim x
        For Each x In .Execute(s)
            InBrackets = InBrackets & Mid(x, 2, Len(x) - 2) & vbLf
        Next
    End With

EndSub

1 个答案:

答案 0 :(得分:1)

You can use this UDF to extract strings enclosed by [...] brackets:

Function InBrackets(s As String) As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "\[\w*\]"
        Dim x
        For Each x In .Execute(s)
            InBrackets = InBrackets & Mid(x, 2, Len(x) - 2) & vbLf
        Next
    End With
End Function

Usage:

B2 : =InBrackets(A2)

EDIT

Okay, so after you better specified your target, with nothing to do with the brackets, Try the follwing:

Sub InsertAnticipatedResults(sh As Worksheet)
    Dim colABC As Long, abc As Range
    With sh
        colABC = .Rows(1).Find(what:="ABC", lookat:=xlWhole).Column
        .Columns(colABC + 1).Insert
        .Cells(1, colABC + 1).value = "Results 1 Anticipated"

        .Columns(colABC + 2).Insert
        .Cells(1, colABC + 2).value = "Results 2 Anticipated"

        Set abc = .Range(.Cells(2, colABC), .Cells(.Rows.Count, colABC).End(xlUp))
    End With

    Dim res1 As String, res2 As String, result1 As String, result2 As String, x
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "^\S*\s*\S*\s"
        For Each abc In abc.Cells
            result1 = "": result2 = ""
            For Each x In .Execute(abc.Text)
                res2 = Trim(x)
                res1 = Trim(Left(res2, Len(res2) - 2))
                res2 = Replace(res2, " ", "")
                res2 = Replace(res2, vbTab, "")

                If Len(result1) > 0 Then result1 = result1 & vbLf: result2 = result2 & vbLf
                result1 = result1 & res1
                result2 = result2 & res2
            Next
            abc.Offset(, 1).value = result1
            abc.Offset(, 2).value = result2
        Next
    End With
End Sub

Sub Testing()
    InsertAnticipatedResults ActiveSheet
End Sub

Test for Rahul