Добрый день, знатоки! Прошу помощи вот в чем... имеется некое количество ячеек, в каждой ячейке есть запись характеризующая количество и размер дефектов.(специфика неразрушающего контроля..) .Вид строки в ячейке такой " Aa0,5<;2Ba2x0,5<;3Аа0,8<" (т.е. код дефекта "Аа" или "Ва". размер "0,5" или "2х0,5" или "0,8". количество дефектов "2Ва"или "3Аа" - т.е. два "Ва" и три "Аа" однотипных дефекта. знак "<" означает, что дефект допускается... дефекты разделяются ";"). задача в следующем... нужно посчитать общую протяженность дефектов! вручную это выполняется следующим образом: Аа=0,5+3*0,8, Ва=2*2=4. 2,9+4=6,9мм.. (дефект "Ва" характеризуется длиной и высотой. но при подсчете протяженности берется большее из значений - либо длина, либо высота..)..Очень прошу, если кто сможет, оформите пожалуйста в виде скрипта, чтобы можно было прикрутить отдельную функцию и далее применять к отдельным ячейкам. Заранее благодарен!!)
Function DefectSum(ByVal txt$) As Double
On Error Resume Next
Dim def, cnt&, Size$, Size1 As Double, Size2 As Double, MaxSize As Double
txt = Replace(txt, ",", ".")
For Each def In Split(txt, ";")
Size$ = "": cnt& = Val(def)
If cnt& = 0 Then cnt& = 1
For i = 2 To Len(def)
If InStr(1, "0123456789", Mid(def, i, 1)) Then Size$ = Mid(def, i): Exit For
Next i
Size1 = Val(Split(Size, "x")(0))
Size2 = Val(Split(Size, "x")(1))
MaxSize = IIf(Size1 > Size2, Size1, Size2)
'Debug.Print cnt, Size$, Size1, Size2
DefectSum = DefectSum + cnt& * MaxSize
Next
End Function
Игорь можно вас еще попросить помочь?.. изменилась форма записи дефектов((( теперь она идет в виде "Fc₁ -1230-0,4-4", где протяженность дефекта последнее значение в строке.. пытался вышеизложенный скрипт подправить)) не получилось..
Function DefectSum(ByVal txt$) As Double
On Error Resume Next
Dim def, cnt&, Size$, Size1 As Double, Size2 As Double, MaxSize As Double
txt = Replace(txt, ",", ".")
For Each def In Split(txt, ";")
Size$ = "": cnt& = Val(def)
If cnt& = 0 Then cnt& = 1
For i = 2 To Len(def)
If InStr(1, "0123456789", Mid(def, i, 1)) Then Size$ = Mid(def, i): Exit For
Next i
Size1 = Val(Split(Size, "x")(0))
Size2 = Val(Split(Size, "x")(1))
MaxSize = IIf(Size1 > Size2, Size1, Size2)
'Debug.Print cnt, Size$, Size1, Size2
DefectSum = DefectSum + cnt& * MaxSize
Next
End Function
Еще раз Спасибо Игорю за функцию, пользовался долгое время! В очередной раз встала проблема.. Код работает, если запись в ячейке произведена в одну строку...а если требуется разделить в одной ячейке на несколько строк посредством Alt+tnter..причем строк может быть и 3 и 4? вышли новые требования к оформлению, и подсчет нарушился...