кстати вопрос интересный и я буквально сегодня пытался найти ответ, еще до созданной темы... Хотя суть вопроса описана не верно, а вот название всё таки AnRusik подобрал правильное... Меня вот что интересует... Иногда попадаются файлы в которых числа представлены как текстовые значения, чтобы их преобразовать в числовые достаточно выделить диапазон с данными "числами" и на во всплывшей менюшке возле курсора (знак восклицания) нажать преобразовать в число. Что интересно то данное телодвижение не возможно записать макрорекордером, точнее возможно, но модуль выходит пустой... Собственно возникает сам вопрос, как это действие записать в код, чтоб в дальнейшем повесить на кнопку?
кстати вопрос интересный и я буквально сегодня пытался найти ответ, еще до созданной темы... Хотя суть вопроса описана не верно, а вот название всё таки AnRusik подобрал правильное... Меня вот что интересует... Иногда попадаются файлы в которых числа представлены как текстовые значения, чтобы их преобразовать в числовые достаточно выделить диапазон с данными "числами" и на во всплывшей менюшке возле курсора (знак восклицания) нажать преобразовать в число. Что интересно то данное телодвижение не возможно записать макрорекордером, точнее возможно, но модуль выходит пустой... Собственно возникает сам вопрос, как это действие записать в код, чтоб в дальнейшем повесить на кнопку?DJ_Marker_MC
Ну пусть моё предложение будет для ручного использования
в целом оно конечно отвечает на суть вопроса, но если сделать так: выделить ячейки и сделать формат текстовый вбить туда числа (соответственно они будут как текст) потом всё это дело выделить и нажать на ТЕКСТ ПО СТОЛБЦАМ - ГОТОВО
то да... они реально становятся числами, но если мы, после два этоо, раза щелкаем в любую из этих ячеек и нажимаем энтер, то значение вновь становится текстовым... А вот второй макрос KuklP - Public Sub w1C_convert() похоже действительно справился с вопросом...
Что касается вопроса автора, то мне кажется он ошибся, почему то мне кажется, что вопрос такой: А есть ли какой-нибудь макрос, чтобы переводил письменную форму числа обратно в ЧИСЛО?
Другими словами если есть надпись в ячейке "Семь" то на выходе хочет получить "7" - сдается мне что вопрос именно в этом.
Цитата (Hugo)
Ну пусть моё предложение будет для ручного использования
в целом оно конечно отвечает на суть вопроса, но если сделать так: выделить ячейки и сделать формат текстовый вбить туда числа (соответственно они будут как текст) потом всё это дело выделить и нажать на ТЕКСТ ПО СТОЛБЦАМ - ГОТОВО
то да... они реально становятся числами, но если мы, после два этоо, раза щелкаем в любую из этих ячеек и нажимаем энтер, то значение вновь становится текстовым... А вот второй макрос KuklP - Public Sub w1C_convert() похоже действительно справился с вопросом...
Что касается вопроса автора, то мне кажется он ошибся, почему то мне кажется, что вопрос такой: А есть ли какой-нибудь макрос, чтобы переводил письменную форму числа обратно в ЧИСЛО?
Другими словами если есть надпись в ячейке "Семь" то на выходе хочет получить "7" - сдается мне что вопрос именно в этом.DJ_Marker_MC
Сообщение отредактировал DJ_Marker_MC - Пятница, 07.06.2013, 21:44
Ну в общем с форматом так и есть, его тоже вручную нужно поменять. Но я вот именно с таким косяком (чтоб был текстовый формат) кажется не сталкивался. Обычно формат общий, а числа забиты как текст.
Ну в общем с форматом так и есть, его тоже вручную нужно поменять. Но я вот именно с таким косяком (чтоб был текстовый формат) кажется не сталкивался. Обычно формат общий, а числа забиты как текст.Hugo
Public Function ToNumber(ByVal this As String) As Double Const sPattern = "миллиард|миллион|тысяч|(пят|шест|сем|восем|девят)(ь|и)с|четыр(е|ёх|ех)с|тр(и|ёх|ех)с|дв(е|ух)с|ст|вос(емь|ьми)д|(сем|шест|пят)(ь|и)д|сорок| (два|три)дца|(один|две|три|четыр|пят|шест|сем|восем|девят)на|дес|дев|вос|сем|шест|пят|чет|тр|дв|од" Dim Strs() As String, i As Long, vValue As Double Dim pEntryReg As New RegExp, vMult As Double Dim subSum As Double, AllSum As Double
this = Application.WorksheetFunction.Trim(this) Strs = Split(Application.WorksheetFunction.Trim(this), " ") If FEntryDict Is Nothing Then InitEntries vMult = 1#: subSum = 0#: AllSum = 0# pEntryReg.IgnoreCase = True: pEntryReg.Pattern = sPattern For i = UBound(Strs) To LBound(Strs) Step -1 vValue = FEntryDict(pEntryReg.Execute(Strs(i))(0).Value) If FMultDict.Exists(CStr(vValue)) Then If subSum > 0# Then AllSum = AllSum + vMult * subSum ElseIf vMult > 1# Then AllSum = AllSum + vMult End If vMult = vValue: subSum = 0# Else subSum = subSum + vValue End If Next If subSum > 0# Then AllSum = AllSum + vMult * subSum ElseIf vMult > 1# Then AllSum = AllSum + vMult End If ToNumber = AllSum End Function
[/vba]
Вариант, протестируйте, пожалуйста. Подключить библиотеки: Microsoft Scripting Runtime, Microsoft VBScript Regular Expressions
Public Function ToNumber(ByVal this As String) As Double Const sPattern = "миллиард|миллион|тысяч|(пят|шест|сем|восем|девят)(ь|и)с|четыр(е|ёх|ех)с|тр(и|ёх|ех)с|дв(е|ух)с|ст|вос(емь|ьми)д|(сем|шест|пят)(ь|и)д|сорок| (два|три)дца|(один|две|три|четыр|пят|шест|сем|восем|девят)на|дес|дев|вос|сем|шест|пят|чет|тр|дв|од" Dim Strs() As String, i As Long, vValue As Double Dim pEntryReg As New RegExp, vMult As Double Dim subSum As Double, AllSum As Double
this = Application.WorksheetFunction.Trim(this) Strs = Split(Application.WorksheetFunction.Trim(this), " ") If FEntryDict Is Nothing Then InitEntries vMult = 1#: subSum = 0#: AllSum = 0# pEntryReg.IgnoreCase = True: pEntryReg.Pattern = sPattern For i = UBound(Strs) To LBound(Strs) Step -1 vValue = FEntryDict(pEntryReg.Execute(Strs(i))(0).Value) If FMultDict.Exists(CStr(vValue)) Then If subSum > 0# Then AllSum = AllSum + vMult * subSum ElseIf vMult > 1# Then AllSum = AllSum + vMult End If vMult = vValue: subSum = 0# Else subSum = subSum + vValue End If Next If subSum > 0# Then AllSum = AllSum + vMult * subSum ElseIf vMult > 1# Then AllSum = AllSum + vMult End If ToNumber = AllSum End Function
Function ToNumber(s As String) Dim i%, j% s = LCase(s) a = Split(s) ReDim b(UBound(a), 1) For i = 0 To UBound(a) s = Trim(a(i)) Select Case s ' исключения Case "ноль" b(i, 0) = 0 Case "десять" b(i, 0) = 10 Case "сорок" b(i, 0) = 40 Case "сто" b(i, 0) = 100 Case Else j = InStr(1, " од дв тр че пя ше се во де", Left(s, 2)) If j > 0 Then b(i, 0) = j / 3 ' число If b(i, 0) > 0 Then If InStr(1, s, "над") > 0 Then b(i, 0) = b(i, 0) + 10 Else If InStr(1, s, "дц") > 0 Or InStr(1, s, "дес") > 0 Or _ InStr(1, s, "нос") Then b(i, 0) = b(i, 0) * 10 If InStr(1, s, "сти") > 0 Or InStr(1, s, "ста") > 0 Or _ InStr(1, s, "сот") Then b(i, 0) = b(i, 0) * 100 End If Else ' порядок If InStr(1, " нр", Mid(s, 7, 1)) > 0 Then b(i, 1) = 1000 End If End Select Next ' собираем ToNumber = 0 For i = 0 To UBound(b, 1) ToNumber = ToNumber + b(i, 0) If b(i, 1) <> 0 Then ToNumber = ToNumber * b(i, 1) Next End Function
[/vba]
Мой вариант. Тоже потестируйте, пожалуйста.
[vba]
Код
Function ToNumber(s As String) Dim i%, j% s = LCase(s) a = Split(s) ReDim b(UBound(a), 1) For i = 0 To UBound(a) s = Trim(a(i)) Select Case s ' исключения Case "ноль" b(i, 0) = 0 Case "десять" b(i, 0) = 10 Case "сорок" b(i, 0) = 40 Case "сто" b(i, 0) = 100 Case Else j = InStr(1, " од дв тр че пя ше се во де", Left(s, 2)) If j > 0 Then b(i, 0) = j / 3 ' число If b(i, 0) > 0 Then If InStr(1, s, "над") > 0 Then b(i, 0) = b(i, 0) + 10 Else If InStr(1, s, "дц") > 0 Or InStr(1, s, "дес") > 0 Or _ InStr(1, s, "нос") Then b(i, 0) = b(i, 0) * 10 If InStr(1, s, "сти") > 0 Or InStr(1, s, "ста") > 0 Or _ InStr(1, s, "сот") Then b(i, 0) = b(i, 0) * 100 End If Else ' порядок If InStr(1, " нр", Mid(s, 7, 1)) > 0 Then b(i, 1) = 1000 End If End Select Next ' собираем ToNumber = 0 For i = 0 To UBound(b, 1) ToNumber = ToNumber + b(i, 0) If b(i, 1) <> 0 Then ToNumber = ToNumber * b(i, 1) Next End Function
AndreTM, а до скольких считать должно? Ради интереса поТЫЦал... всё вроде гуд... но не распознало "Тысяча" хотя распознаёт "Восемь тысяч". Ну и миллион тоже не по зубам коду оказался)))
AndreTM, а до скольких считать должно? Ради интереса поТЫЦал... всё вроде гуд... но не распознало "Тысяча" хотя распознаёт "Восемь тысяч". Ну и миллион тоже не по зубам коду оказался)))DJ_Marker_MC
For i = LBound(ar) To UBound(ar) Select Case ar(i) Case "тысяч", "тысяча", "тысячи": x = x * 1000 Case "миллион", "миллиона", "миллионов": x = x * 1000 ^ (2 + tys) Case "миллиард", "миллиарда", "миллиардов": x = x * 1000 ^ IIf(mln, 1, IIf(tys, 2, 3)) Case Else For j = LBound(Nums1) To UBound(Nums1) If Nums1(j) = ar(i) Then x = x + Nums2(j): Exit For Next j End Select Next i пропись2число3 = x End Function
For i = LBound(ar) To UBound(ar) Select Case ar(i) Case "тысяч", "тысяча", "тысячи": x = x * 1000 Case "миллион", "миллиона", "миллионов": x = x * 1000 ^ (2 + tys) Case "миллиард", "миллиарда", "миллиардов": x = x * 1000 ^ IIf(mln, 1, IIf(tys, 2, 3)) Case Else For j = LBound(Nums1) To UBound(Nums1) If Nums1(j) = ar(i) Then x = x + Nums2(j): Exit For Next j End Select Next i пропись2число3 = x End Function
один миллион = 1000 восемь миллиардов четыре тысячи триста семьдесят восемь = 8004378 сто сорок семь миллиардов двадцать два миллиона = 147022000 два миллиарда пятнадцать тысяч пятьсот = 2015500 Три миллиарда = 3000
Цитата (AndreTM)
Мой вариант. Тоже потестируйте, пожалуйста.
один миллион = 1000 восемь миллиардов четыре тысячи триста семьдесят восемь = 8004378 сто сорок семь миллиардов двадцать два миллиона = 147022000 два миллиарда пятнадцать тысяч пятьсот = 2015500 Три миллиарда = 3000MCH
мне как-то тоже аналогичная задача попадалась. Только она была чуть сложнее - текст с числами прописью. Найти числа и преобразовать (в т.ч. дробные). Вытаскивать пришлось самописной регуляркой, а преобразованием занималась функция MCH (насколько помню)
мне как-то тоже аналогичная задача попадалась. Только она была чуть сложнее - текст с числами прописью. Найти числа и преобразовать (в т.ч. дробные). Вытаскивать пришлось самописной регуляркой, а преобразованием занималась функция MCH (насколько помню) nerv
Чебурашка стал символом олимпийских игр. А чего достиг ты? Тишина - самый громкий звук
Это я тогда поторопился - ведь записывал же явные степени 1000, а затем что-то переклинило... Так что теперь я решил избавиться от второго массива, изменил порядок суммирования - и сошлось
[vba]
Код
Function ToNumber(s As String) Dim i%, j& a = Split(LCase(s)) For i = LBound(a) To UBound(a) s = Trim(a(i)) Select Case s Case "ноль" a(i) = 0 Case "десять" a(i) = 10 Case "сорок" a(i) = 40 Case "сто" a(i) = 100 Case Else a(i) = 0 j = InStr(1, " од дв тр че пя ше се во де", Left(s, 2)) If j > 0 Then a(i) = j / 3 ' число If a(i) > 0 Then If InStr(1, s, "над") > 0 Then a(i) = a(i) + 10 Else If InStr(1, s, "дц") > 0 Or InStr(1, s, "дес") > 0 Or _ InStr(1, s, "нос") Then a(i) = a(i) * 10 If InStr(1, s, "сти") > 0 Or InStr(1, s, "ста") > 0 Or _ InStr(1, s, "сот") Then a(i) = a(i) * 100 End If Else ' порядок j = InStr(1, " нр", Mid(s, 7, 1)) If j > 0 Then a(i) = 1000 ^ j End If End Select Next ToNumber = 0 j = 1 For i = UBound(a) To LBound(a) Step -1 If a(i) >= 1000 Then j = a(i) Else ToNumber = ToNumber + a(i) * j Next End Function
[/vba]
Цитата (MCH)
один миллион = 1000 ...
Это я тогда поторопился - ведь записывал же явные степени 1000, а затем что-то переклинило... Так что теперь я решил избавиться от второго массива, изменил порядок суммирования - и сошлось
[vba]
Код
Function ToNumber(s As String) Dim i%, j& a = Split(LCase(s)) For i = LBound(a) To UBound(a) s = Trim(a(i)) Select Case s Case "ноль" a(i) = 0 Case "десять" a(i) = 10 Case "сорок" a(i) = 40 Case "сто" a(i) = 100 Case Else a(i) = 0 j = InStr(1, " од дв тр че пя ше се во де", Left(s, 2)) If j > 0 Then a(i) = j / 3 ' число If a(i) > 0 Then If InStr(1, s, "над") > 0 Then a(i) = a(i) + 10 Else If InStr(1, s, "дц") > 0 Or InStr(1, s, "дес") > 0 Or _ InStr(1, s, "нос") Then a(i) = a(i) * 10 If InStr(1, s, "сти") > 0 Or InStr(1, s, "ста") > 0 Or _ InStr(1, s, "сот") Then a(i) = a(i) * 100 End If Else ' порядок j = InStr(1, " нр", Mid(s, 7, 1)) If j > 0 Then a(i) = 1000 ^ j End If End Select Next ToNumber = 0 j = 1 For i = UBound(a) To LBound(a) Step -1 If a(i) >= 1000 Then j = a(i) Else ToNumber = ToNumber + a(i) * j Next End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
