Dim shSrc As Worksheet, shRes As Worksheet Dim arrSrc(), arrRes(), lr As Long, i As Long
Application.ScreenUpdating = False
Set shSrc = ActiveSheet Set shRes = Worksheets.Add(After:=shSrc) lr = shSrc.Cells(shSrc.Rows.Count, "A").End(xlUp).Row arrSrc() = shSrc.Range("A1:A" & lr).Value ReDim arrRes(1 To UBound(arrSrc), 1 To 4)
For i = 1 To UBound(arrSrc) arrRes(i, 1) = Parsing(arrSrc(i, 1), "[trn] ", "[/trn]") arrRes(i, 2) = Parsing(arrSrc(i, 1), " /", "/") arrRes(i, 3) = Parsing(arrSrc(i, 1), "|", "|") arrRes(i, 4) = Parsing(arrSrc(i, 1), "[url]", "[/url]") Next i
Private Function Parsing(varSrc, strLeftTag As String, strRigthTag As String) As String
Dim lngInStr1 As Long, lngInStr2 As Long, var
lngInStr1 = InStr(varSrc, strLeftTag) If lngInStr1 = 0 Then Exit Function var = Mid(varSrc, lngInStr1 + Len(strLeftTag)) lngInStr2 = InStr(var, strRigthTag) var = Left(var, lngInStr2 - 1) Parsing = var
End Function
[/vba]
[vba]
Код
Sub Разделить()
Dim shSrc As Worksheet, shRes As Worksheet Dim arrSrc(), arrRes(), lr As Long, i As Long
Application.ScreenUpdating = False
Set shSrc = ActiveSheet Set shRes = Worksheets.Add(After:=shSrc) lr = shSrc.Cells(shSrc.Rows.Count, "A").End(xlUp).Row arrSrc() = shSrc.Range("A1:A" & lr).Value ReDim arrRes(1 To UBound(arrSrc), 1 To 4)
For i = 1 To UBound(arrSrc) arrRes(i, 1) = Parsing(arrSrc(i, 1), "[trn] ", "[/trn]") arrRes(i, 2) = Parsing(arrSrc(i, 1), " /", "/") arrRes(i, 3) = Parsing(arrSrc(i, 1), "|", "|") arrRes(i, 4) = Parsing(arrSrc(i, 1), "[url]", "[/url]") Next i
Private Function Parsing(varSrc, strLeftTag As String, strRigthTag As String) As String
Dim lngInStr1 As Long, lngInStr2 As Long, var
lngInStr1 = InStr(varSrc, strLeftTag) If lngInStr1 = 0 Then Exit Function var = Mid(varSrc, lngInStr1 + Len(strLeftTag)) lngInStr2 = InStr(var, strRigthTag) var = Left(var, lngInStr2 - 1) Parsing = var
Добрый день. Вариант пользовательской функцией [vba]
Код
Function Beazehuginn(t As String, c) As String On Error Resume Next With CreateObject("VBScript.RegExp") .Global = True .Pattern = "((?:\[trn\])(.+)(?:\[\/trn\]))|((?:\[\/c\])( \/.+\/)(?:\[c))|((?:\|)(.+)(?:\|))|((?:url\])(.+)(?:\[\/url\]))" Beazehuginn = .Execute(t)(c - 1).submatches(c * 2 - 1) End With End Function
[/vba]
Добрый день. Вариант пользовательской функцией [vba]
Код
Function Beazehuginn(t As String, c) As String On Error Resume Next With CreateObject("VBScript.RegExp") .Global = True .Pattern = "((?:\[trn\])(.+)(?:\[\/trn\]))|((?:\[\/c\])( \/.+\/)(?:\[c))|((?:\|)(.+)(?:\|))|((?:url\])(.+)(?:\[\/url\]))" Beazehuginn = .Execute(t)(c - 1).submatches(c * 2 - 1) End With End Function
В любую функцию необходимо передать параметры. В данном случае: 1 - непосредственно сам текст, 2- это какой кусок необходимо вытащить (1,2,3 или 4) В файле, который я приложил, функция была записана
Код
=Beazehuginn($A1;СТОЛБЕЦ(A1))
где СТОЛБЕЦ(A1) дает нам цифру 1, можно записать и так
В любую функцию необходимо передать параметры. В данном случае: 1 - непосредственно сам текст, 2- это какой кусок необходимо вытащить (1,2,3 или 4) В файле, который я приложил, функция была записана
Код
=Beazehuginn($A1;СТОЛБЕЦ(A1))
где СТОЛБЕЦ(A1) дает нам цифру 1, можно записать и так
Код
=Beazehuginn($A1;1)
но такая формула не будет протягиваться вправоsboy