добрый день уважаемый РАЗУМ. Нужна помощь в решении такой проблемы. есть таблица 240 000 строк в которой есть 3 столбца. нужно - во втором столбце найти строку со значением LKR и на этой строке в 3 столбце сделать парсинг $$aHOL$$lBGU01$$b000018261$$nARANN, что б найти значение $$b000018261 на это число нужно заменить в первом столбце все значения между LKR (их может быть 2, 3 или 4 значения - строки) в файле - страница in - это ввод, страница out -такой должен быть вывод. заранее спасибо за помощь
добрый день уважаемый РАЗУМ. Нужна помощь в решении такой проблемы. есть таблица 240 000 строк в которой есть 3 столбца. нужно - во втором столбце найти строку со значением LKR и на этой строке в 3 столбце сделать парсинг $$aHOL$$lBGU01$$b000018261$$nARANN, что б найти значение $$b000018261 на это число нужно заменить в первом столбце все значения между LKR (их может быть 2, 3 или 4 значения - строки) в файле - страница in - это ввод, страница out -такой должен быть вывод. заранее спасибо за помощьtigrik
Добрый день. Вариант пользовательской функцией В функцию передаем диапазон второго столбца, нижнюю границу закрепляем $, верхнюю нет [vba]
Код
Function tigrik(r As Range) As String lkr = WorksheetFunction.Match("LKR", r, 0) fstring = r.Cells(lkr).Offset(0, 1).Value With CreateObject("VBScript.RegExp") .Pattern = "\d{9}" tigrik = .Execute(fstring)(0) End With End Function
[/vba]
Добрый день. Вариант пользовательской функцией В функцию передаем диапазон второго столбца, нижнюю границу закрепляем $, верхнюю нет [vba]
Код
Function tigrik(r As Range) As String lkr = WorksheetFunction.Match("LKR", r, 0) fstring = r.Cells(lkr).Offset(0, 1).Value With CreateObject("VBScript.RegExp") .Pattern = "\d{9}" tigrik = .Execute(fstring)(0) End With End Function
Dim arrRes(), arrBC(), strLKR As String Dim var, lngInStr As Long, lr As Long, i As Long
lr = Cells(Rows.Count, "B").End(xlUp).row arrBC() = Range("B1:C" & lr).Value ReDim arrRes(1 To UBound(arrBC), 1 To 1) For i = UBound(arrBC) To 1 Step -1 If arrBC(i, 1) = "LKR" Then var = arrBC(i, 2) lngInStr = InStr(var, "$$b") var = Mid(var, lngInStr + 3) lngInStr = InStr(var, "$$") var = Left(var, lngInStr - 1) strLKR = var End If arrRes(i, 1) = strLKR Next i Range("A1:A" & UBound(arrRes)).Value = arrRes() MsgBox "Готово!", vbInformation
End Sub
[/vba]
Макрос обрабатывает все строки.
[vba]
Код
Sub Парсинг()
Dim arrRes(), arrBC(), strLKR As String Dim var, lngInStr As Long, lr As Long, i As Long
lr = Cells(Rows.Count, "B").End(xlUp).row arrBC() = Range("B1:C" & lr).Value ReDim arrRes(1 To UBound(arrBC), 1 To 1) For i = UBound(arrBC) To 1 Step -1 If arrBC(i, 1) = "LKR" Then var = arrBC(i, 2) lngInStr = InStr(var, "$$b") var = Mid(var, lngInStr + 3) lngInStr = InStr(var, "$$") var = Left(var, lngInStr - 1) strLKR = var End If arrRes(i, 1) = strLKR Next i Range("A1:A" & UBound(arrRes)).Value = arrRes() MsgBox "Готово!", vbInformation
Karataev, спасибо большое, но на большом файле вылетает с ошибкой (((( обнуляется lngInStr = InStr(var, "$$") и после этого вылетает на var = Left(var, lngInStr - 1)
Karataev, спасибо большое, но на большом файле вылетает с ошибкой (((( обнуляется lngInStr = InStr(var, "$$") и после этого вылетает на var = Left(var, lngInStr - 1)tigrik
вот все строки, которые, видимо, неправильно оформлены Длина строки в столбце С 000000355 LKR $$aHOL$$lBGU01$$b001087179 26 000000359 LKR $$aHOL$$lBGU01$$b001087184 26 000000650 LKR $$aHOL$$lBGU01$$b001087503 26 000000935 LKR $$aHOL$$lBGU01$$b001087815 26
вот все строки, которые, видимо, неправильно оформлены Длина строки в столбце С 000000355 LKR $$aHOL$$lBGU01$$b001087179 26 000000359 LKR $$aHOL$$lBGU01$$b001087184 26 000000650 LKR $$aHOL$$lBGU01$$b001087503 26 000000935 LKR $$aHOL$$lBGU01$$b001087815 26abtextime
abtextime, спасибо, действительно. Но я посмотрел, что в этом файле есть много таких строк. можно парсировать иначе? отсюда мне надо $$b000018261 это всегда 9 значений. сейчас я получил новый файл с уже 400 000 строк.
abtextime, спасибо, действительно. Но я посмотрел, что в этом файле есть много таких строк. можно парсировать иначе? отсюда мне надо $$b000018261 это всегда 9 значений. сейчас я получил новый файл с уже 400 000 строк.tigrik
Сообщение отредактировал tigrik - Воскресенье, 18.02.2018, 12:06
функция уважаемого sboy, Function tigrik(r As Range) As String lkr = WorksheetFunction.Match("LKR", r, 0) fstring = r.Cells(lkr).Offset(0, 1).Value With CreateObject("VBScript.RegExp") .Pattern = "\d{9}" tigrik = .Execute(fstring)(0) End With End Function отрабатывает великоплепно, но как ее размножить на весь столбец А?
функция уважаемого sboy, Function tigrik(r As Range) As String lkr = WorksheetFunction.Match("LKR", r, 0) fstring = r.Cells(lkr).Offset(0, 1).Value With CreateObject("VBScript.RegExp") .Pattern = "\d{9}" tigrik = .Execute(fstring)(0) End With End Function отрабатывает великоплепно, но как ее размножить на весь столбец А?tigrik
Dim arrRes(), arrBC(), strLKR As String Dim var, lngInStr As Long, lr As Long, i As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row arrBC() = Range("B1:C" & lr).Value ReDim arrRes(1 To UBound(arrBC), 1 To 1) For i = UBound(arrBC) To 1 Step -1 If arrBC(i, 1) = "LKR" Then var = arrBC(i, 2) lngInStr = InStr(var, "$$b") var = Mid(var, lngInStr + 3) lngInStr = InStr(var, "$$") If lngInStr <> 0 Then var = Left(var, lngInStr - 1) End If strLKR = var End If arrRes(i, 1) = strLKR Next i Range("A1:A" & UBound(arrRes)).Value = arrRes() MsgBox "Готово!", vbInformation
End Sub
[/vba]
[vba]
Код
Sub Парсинг()
Dim arrRes(), arrBC(), strLKR As String Dim var, lngInStr As Long, lr As Long, i As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row arrBC() = Range("B1:C" & lr).Value ReDim arrRes(1 To UBound(arrBC), 1 To 1) For i = UBound(arrBC) To 1 Step -1 If arrBC(i, 1) = "LKR" Then var = arrBC(i, 2) lngInStr = InStr(var, "$$b") var = Mid(var, lngInStr + 3) lngInStr = InStr(var, "$$") If lngInStr <> 0 Then var = Left(var, lngInStr - 1) End If strLKR = var End If arrRes(i, 1) = strLKR Next i Range("A1:A" & UBound(arrRes)).Value = arrRes() MsgBox "Готово!", vbInformation