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
- 20039 просмотров
Новые записи в блогах
- Устранение дребезга контактов на основе вертикальных счетчиков
- Диагностика 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 года никому не мешало и вдрук заметил кто-то...