Страницы: 1
RSS
Выборка данных из ячейки. Создание отдельной функции.
 
Добрый день, знатоки! Прошу помощи вот в чем... имеется некое количество ячеек, в каждой ячейке есть запись характеризующая количество и размер дефектов.(специфика неразрушающего контроля..) .Вид строки в ячейке такой " 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мм.. (дефект "Ва" характеризуется длиной и высотой. но при подсчете протяженности берется большее из значений - либо длина, либо высота..)..Очень прошу, если кто сможет, оформите пожалуйста в виде скрипта, чтобы можно было прикрутить отдельную функцию и далее применять к отдельным ячейкам. Заранее благодарен!!)
Изменено: Sanic - 01.05.2015 19:27:15
 
а пример за Вас рисовать?
 
 "Aa0,5<;2Ba2x0,5<;3Аа0,8<" - вид строки в ячейке А1.. результат в отдельной ячейке А2 - 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
См. вложение, — формулу в желтой ячейке
 
8-0 фигасе!!! Спасибо ОГРОМНОЕ Игорь!!
 
забыл кое-что
после строки
Код
Size$ = "": cnt& = Val(def)

надо добавить строку
Код
Size1 = 0 : Size2 = 0

иначе, могут быть ошибки
 
ок! Спасибо еще раз!! выручил!! да еще и так быстро!гений!
 
Игорь можно вас еще попросить помочь?.. изменилась форма записи дефектов((( теперь она идет в виде "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? вышли новые требования к оформлению, и подсчет нарушился...

как можно решить эту задачку?
Изменено: Sanic - 27.07.2018 12:57:08
 
файл для примера..
 
Наконец появился пример :)
Глубоко не вникал как там что считается, но может просто убить этот перенос?
Добавьте в код (перед 5-ой строкой) такую строку:
Код
txt = Replace(txt, Chr(10), "")
Изменено: Hugo - 29.07.2018 14:21:32
 
Hugo,Спасибо! помогло!)
Страницы: 1
Наверх