Excel - разбор резисторов по номиналам

вот так это выглядит в excelПришла немаленькая кучка чип-резисторов.

Надо бы занести в табличку - что есть, сколько, какой корпус и т.д. Но вот опять заморочки с номиналами: некоторые поставщики пишут 1,2 kOhm, некоторые 1к2 (с РУССКИМ "к"!) etc. Бардак, короче.

А хочется ж однообразно, и сортировка, опять таки... Пол-года назад брался, но ничего не вышло - тупо не получалось заставить использовать Excel написаную функцию. Но - сегодня получилось. Рад, аж на стуле подпрыгиваю.

 

По поводу кода: да, говнокод. Да, позорно не использовал классы, объекты и прочие галюциногены.

Регексп подключать обломался, хотя с ним, конечно, намного удобнее. Как вставить функцию написано здесь: http://www.firststeps.ru/vba/excel/r.php?72 На входе функции номинал резистора, на выходе - сопротивление в омах

Сама функция

Function ResNominal(x As String) As Double
'
'
Dim res As Single
Dim j, i As Integer
Dim tr As String
j = 1
i = Len(x)
Mylenght = Len(x)
R = "R"
Do While j <= Mylenght
    l = Mid(x, j, 1)
    If IsNumeric(l) Then
    tr = tr + l
    Else: Exit Do
    End If
    j = j + 1
Loop
' Вычисляем порядок левой группы цифр

If l = "." Or l = "," Then
    LeftNumber = Val(tr)
    R = "."
ElseIf l = "R" Or l = "r" Then
    LeftNumber = Val(tr)
    R = "R"
ElseIf l = "k" Or l = "K" Or l = "ê" Or l = "Ê" Then
    LeftNumber = Val(tr) * 1000
    R = "K"
ElseIf l = "M" Or l = "m" Or l = "ì" Or l = "Ì" Then
    LeftNumber = Val(tr) * 1000000
    R = "M"
Else: LeftNumber = Val(tr)
End If
j = j + 1

If j > Mylenght Then
    res = LeftNumber
Else
    '  вычисляем правую группу цифр
    tr = ""
    Do While j <= Mylenght
        l = Mid(x, j, 1)
        If IsNumeric(l) Then
            tr = tr + l
        Else: Exit Do
        End If
        j = j + 1
    Loop
    lt = Len(tr)
    If lt > 0 Then
        If R = "R" Or R = "." Then res = LeftNumber + Val("0." + tr)
        If R = "K" Then res = LeftNumber + Val(tr) * 10 ^ (3 - lt)
        If R = "M" Then res = LeftNumber + Val(tr) * 10 ^ (6 - lt)
    Else: res = LeftNumber
    End If
    If R = "." Then
        l = Mid(x, j, 1)
        Do While (j <= Mylenght)
            l = Mid(x, j, 1)
            If l = "k" Or l = "K" Or l = "ê" Or l = "Ê" Then
                res = res * 1000
                Exit Do
            ElseIf l = "M" Or l = "m" Or l = "ì" Or l = "Ì" Then
                res = res * 1000000
                Exit Do
            ElseIf l = "O" Or l = "Î" Or l = "î" Or l = "o" Then
                Exit Do
            End If
            j = j + 1
        Loop
    End If
End If
ResNominal = res
x = "1R8"
Ar = Val(x)
End Function

 

Кому лениво копипастить - в аттаче файл. его надо просто импортировать в редакторе вижуала как модуль.

Единственный облом - не удалось заставить работать функцию, если модуль импортировать в personal.xls. Работает, только если модуль в том файле, откуда идет вызов. Разбираться с этим уже не хотелось - меня более чем устраивает и в таком виде.

ПредпросмотрAttachmentSize
module1.rar581 байт

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

кракозябры в комментариях скрипта

тема, собственно. поправьте, пожалуйста, для придания благолепия )

ЗЫ. за материалы сайта, конечно, спасибо )

Поправил

Надо ж. 4 года никому не мешало и вдрук заметил кто-то...

воркалось....