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. Работает, только если модуль в том файле, откуда идет вызов. Разбираться с этим уже не хотелось - меня более чем устраивает и в таком виде.
- блог пользователя Monster
- 20901 просмотр
Новые записи в блогах
- Устранение дребезга контактов на основе вертикальных счетчиков
- Диагностика Imprecise Bus Faults в микроконтроллерах Cortex-M3/M4/M4F
- Self-powered камера
- Фоновый модулятор: беспроводная связь из ничего (перевод)
- Texas Instruments Analog Applications Journal SLYT612 "Снижение искажений в аналоговых КМОП ключах" (перевод)
- USB MSD. Часть 6. Команды SCSI (перевод)
- USB MSD. Часть 3. USB класс накопителей данных (перевод)
- Texas Instruments Application Report SBAA042 "Кодовые схемы, используемые в аналогово-цифровых преобразователях" (перевод)
- 10 принципов правильного интерфейса
- Релиз SDK на русский микропроцессор КРОЛИК


Комментарии
кракозябры в комментариях скрипта
тема, собственно. поправьте, пожалуйста, для придания благолепия )
ЗЫ. за материалы сайта, конечно, спасибо )
Поправил
Надо ж. 4 года никому не мешало и вдрук заметил кто-то...