Добрый вечер. Собираю БД, данные беру с сайтов типа http://docs.cntd.ru/document/1200041199 С указанного сайта интересуют таблицы 2-4. Данные с них извлекаю с помощью PQ.
Вроде быстро, но есть затык - как быстро "разделить строки", содержащие текстовые диапазоны типа "от ... до ...".
В примере на вкладке "Table 1" ячейка В2 содержит "От 0,10 (1,0) до 0,63 (6,3) включ.". Есть ряд значений, "0,1", "0,25", "0,63", "1,0", "1,6", "2,5", ... по которому можно вручную определить количество строк на которое нужно разделить ячейку. В данном случае - на 3 строки. Но хотелось бы этот муторный процесс как-то автоматизировать, т.к. количество строк может отличаться, да и таблиц таких несколько.
Можно ли каким-то образом, кроме ручного, это сделать? Логика такая, чтобы получилось как на вкладке "Table 1_1" (делалось вручную). Если это можно сделать - прошу поделиться хотя бы идеями; если нет - придется вручную ворошить...
Если честно, вообще ничего не понятно. Есть ячейка B2, в ней прописан текст "От 0,10 (1,0) до 0,63 (6,3) включ.". Где то видимо есть ряд значений "0,1", "0,25", "0,63", "1,0", "1,6", "2,5", ... ", лучше указать где именно он есть. Какую ячейку нужно разделить на количество строк? И что вообще такое "разделить ячейку на строки"?
VasiliY_Seryugin, по ряду значений - согласен; лучше, наверное, чтобы он находился на отдельной вкладке. По описанию - попробую еще раз) Условием разделения одной исходной строки на несколько является значение в соответствующей ячейке столбца B. Из значения, например, B2, надо как-то получить данные - на какое количество строк размножится исходная строка, в каждую ячейку B из которых должно попасть одно из значений списка. По примеру - строка 2 на вкладке "Table 1" должна размножиться на три строки 2,3,4 на вкладке "Table 1_1", в ячейки B2, B3, B4 "Table 1_1" должны попасть "0,1", "0,25", "0,63" соответственно. Это тяжело понять, если не смотреть пример.
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim arr
Dim re As Object
Dim objMatches As Object
Dim Chislo As Double
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.Pattern = "\((.+?)\)"
For i = iLastRow To 2 Step -1
Set objMatches = re.Execute(Cells(i, "B"))
Chislo = objMatches.Item(1).SubMatches(0)
Select Case Chislo
Case 6.3
arr = Array(0.1, 0.25, 0.63)
Case 40
arr = Array(1, 1.6, 2.5, 4)
Case 63
arr = Array(1, 1.6, 2.5, 4, 6.3)
Case 100
arr = Array(1, 1.6, 2.5, 4, 6.3, 10)
Case 160
arr = Array(1, 1.6, 2.5, 4, 6.3, 10, 16)
End Select
For n = UBound(arr) To 0 Step -1
Rows(i + 1).Insert
Cells(i + 1, "B") = arr(n)
Cells(i + 1, "A") = Cells(i, "A")
Range("C" & i & ":H" & i).Copy Cells(i + 1, "C")
Next
Rows(i).Delete
Next
Application.ScreenUpdating = True
End Sub
buchlotnik, не обрабатываются "одиночные" значения (если вместо текстового диапазона стоит одно значение, например, "2,5 (25)"), прошу указать, где подправить:
Код
let
l="http://docs.cntd.ru/document/1200041199#",
m={0.1,0.25,0.63,1,1.6,2.5,4.0,6.3,10,16},
n={"Условный проход (номинальный размер)", "", "_1", "_2", "_3", "_4", "_5", "_6"},
t="Номинальное (условное) давление , МПа (кгс/см)",
f=(x,y,z)=>List.Select(x,(x)=>x>=y and x<=z),
g=(x,y)=>Number.From(Text.BetweenDelimiters(x,"(",")",y,0))/10,
h=(x)=>[a=g(x,0), b=g(x,1), c=f(m,a,b)][c],
from = Table.PromoteHeaders(Web.Page(Web.Contents(l)){3}[Data]),
typ = Table.TransformColumnTypes(from,List.Transform(n,(x)=>{x,Number.Type})),
err = Table.ReplaceErrorValues(typ, List.Transform(n,(x)=>{x,null})),
fill = Table.FillDown(err,n),
to = Table.ExpandListColumn(Table.TransformColumns(fill,{t,h}), t)
in
to
Ваш код немного подправил, чтобы "съедал" таблицу 4 с сайта, но на одиночных значениях выдает "null" (если промотать в PQ в конец таблицы)...
Kuzmich, специально скачал свой же пример, вставил в него Ваш макрос - то тот же эффект. Хоть в "Лист 1 (Table 1)", хоть в "Эта книга". Я туплю или все-таки где-то ошибочка закралась?