Лайфхак в Excel: как подгрузить курсы валют с сайта ЦБ. Макрос перевод валюты
Функция получения курса валют с сайта ЦБ РФ
Данный код (пользовательская функция) позволяет получить данные о курсе валюты с сайта Центробанка.
Данную функцию можно использовать и в виде формулы на листе Excel (см. пример во вложении)
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double ' функция возвращает курс валюты CurrencyName на дату RateDate ' в случае ошибки (неверная дата или название валюты) возвращается 0 On Error Resume Next CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy") If xmldoc.Load(url_request) <> True Then Exit Function ' Запрос к серверу ЦБР ' Обработка полученного ответа Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/Valute") For i = 0 To nodeList.Length - 1 ' поиск нужной валюты Set xmlNode = nodeList.Item(i).CloneNode(True) If xmlNode.childNodes(1).Text = CurrencyName Then CurrencyRate = CDbl(xmlNode.childNodes(4).Text) divisor = Val(xmlNode.childNodes(2).Text) GetRate = CurrencyRate / divisor Exit Function End If Next End Function Sub ПримерИспользованияФункции_GetRate() MsgBox "Сегодня курс доллара к рублю составил " & GetRate("USD", Now), vbInformation MsgBox "А вчера курс евро к рублю был равен " & GetRate("EUR", Now - 1), vbInformation End SubПоддерживается получение курсов рубля по отношению к следующим валютам:
AUD Австралийский долларAZN Азербайджанский манатGBP Фунт стерлингов Соединенного королевстваAMD Армянский драмBYR Белорусский рубльBGN Болгарский левBRL Бразильский реалHUF Венгерский форинтDKK Датская кронаUSD Доллар СШАEUR ЕвроINR Индийская рупияKZT Казахский тенгеCAD Канадский долларKGS Киргизский сомCNY Китайский юаньLVL Латвийский латLTL Литовский литMDL Молдавский лейNOK Норвежская кронаPLN Польский злотыйRON Новый румынский лейXDR СДР (специальные права заимствования)SGD Сингапурский долларTJS Таджикский сомониTRY Турецкая лираTMT Новый туркменский манатUZS Узбекский сумUAH Украинская гривнаCZK Чешская кронаSEK Шведская кронаCHF Швейцарский франкEEK Эстонская кронаZAR Южноафриканский рэндKRW Вон Республики КореяJPY Японская иена
Если вы желаете вывести информацию по всем валютам - используйте макрос ВывестиСегодняшниеКурсыВсехВалют:
Sub ВывестиСегодняшниеКурсыВсехВалют() On Error Resume Next Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd\/mm\/yyyy") If xmldoc.Load(url_request) <> True Then Exit Sub Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/Valute") For i = 0 To nodeList.Length - 1 Set xmlNode = nodeList.Item(i).CloneNode(True) Debug.Print "Курс " & xmlNode.childNodes(1).Text & " (установлен " & strDate & "): " & _ xmlNode.childNodes(4).Text & " рублей за " & xmlNode.childNodes(2).Text & _ " " & xmlNode.childNodes(3).Text Next End SubРезультат работы макроса ВывестиСегодняшниеКурсыВсехВалют:
Курс AUD (установлен 28/07/2010): 27,2968 рублей за 1 Австралийский долларКурс AZN (установлен 28/07/2010): 37,6342 рублей за 1 Азербайджанский манатКурс BRL (установлен 28/07/2010): 17,1589 рублей за 1 Бразильский реал...Курс HUF (установлен 28/07/2010): 13,7407 рублей за 100 Венгерских форинтовКурс DKK (установлен 28/07/2010): 52,7135 рублей за 10 Датских кронКурс USD (установлен 28/07/2010): 30,2391 рублей за 1 Доллар СШАКурс EUR (установлен 28/07/2010): 39,3139 рублей за 1 Евро...Курс CHF (установлен 28/07/2010): 28,6953 рублей за 1 Швейцарский франкКурс EEK (установлен 28/07/2010): 25,1057 рублей за 10 Эстонских кронКурс ZAR (установлен 28/07/2010): 41,1383 рублей за 10 Южноафриканских рэндовКурс KRW (установлен 28/07/2010): 25,6003 рублей за 1000 Вон Республики Корея
| CurrencyRates.xls | 33.5 КБ | 287 | 9 недель 3 дня назад |
excelvba.ru
Импорт курсов валюты в Excel
Описание работы
Один из самых эффективных способов вставить курс валюты с сайта ЦБ в ячейку Excel - использовать надстройку с макросом. После установки программы VBA-Excel у вас появится новая вкладка на ленте с командой вызова функции Курс валюты.
Эта команда открывает удобную форму для импорта курса на заданную дату.
Выбор даты импорта
На форме имеется встроенный календарь для выбора даты на которую импортируется курс валюты. По умолчанию выбрана текущая дата.
Установить текущую дату можно также нажав на кнопку Сегодня в календаре
Выбор валюты
Далее необходимо указать курс какой валюты необходимо импортировать. Для этого кликните по нужной строке в списке.
Для выбора доступны все валюты с сайта ЦБ РФ. Для удобства самые популярные курсы доллара и евро вынесены в начало списка. Остальные отсортированы по алфавиту.
Выбор единицы расчета
Обратите внимание, что не все курсы валют берутся из расчета за 1 единицу. Например, для Армянских драммов расчет ведется за 100 единиц. Если необходимо, чтобы курс вставлялся за 1 единицу, то установите опцию В расчете за 1 единицу валюты в нижнем левом углу.
Тип вставки
Если вы не планируете обновлять курс валюты в дальнейшем, то советую вставлять курс валюты "текстом" тогда Excel не будет обращаться к сайту ЦБ для обновления данных. Для этого нажмите кнопку Вставка текстом.
Если вы хотите периодически обновлять курс (например на текущую дату), то используйте кнопку Вставить формулой. В этом случае в выбранную ячейку вставится функция КУРС с установленными параметрами.
Использовать функцию КУРС
Вставить курс валюты Вызвать функцию можно с помощью функции. Использовать ее можно так же как и любую другую встроенную в Excel - просто введите в ячейку =КУРС([Дата]; [ВАЛЮТА]; [За1ед]).
- [Дата] - Дата, на которую необходимо определить валюту. По умолчанию текущая дата.
- [ВАЛЮТА] - Текст, определяющий код валюты в соответствии с сайтом cbr.ru. По умолчанию USD.
- [За1ед] - Не все курсы валют на сайте Центробанка указываются за 1 единицу валюты. Чтобы валюта рассчитывалась из расчета за 1 единицу укажите значение этой переменной = 1
Само собой необходим интернет для пользования данной функцией. Прошу не мучить свой компьютер, интернет и не делать выгрузку курсов за большой период времени, для этого на сайте Центробанка есть специальный функционал.
Пример 1
Получение курса USD на сегодня.
Пример 2
Получение различных курсов валют на сегодня.
Пример 3
Получение динамики курса доллара за 5 дней.
Пример 4
Получение курсов валюты из расчета за 1 единицу валюты на текущую дату.
micro-solution.ru
Курс валют в Excel c сайта
Нельзя изменять часть массива. Ошибка ExcelЯ конечно слышал, что встроенными инструментами Excel, можно забирать данные с сайтов, точнее с веб-страниц. Но руки не доходили, пока не пришлось решать реальные задачи, как вывести курс валют в Excel. А задача была простая вывести данные по курсу бакса, евро и юаня на настоящий момент. Взялся, разобрался, рассказываю.
Конечно, у меня были подозрения, что можно написать простенький запрос и куда-нить его разместить в Excel. И встроенным инструментом он будет забирать данные с веб страницы. Так и вышло, инструмент Данные — Импорт внешних данных — Создать веб-запрос уже встроен в табличный редактор. Подробнее как это сделать ниже:
Как получить курс валют в excel с сайта?
Предварительно найдите сайт откуда вы будете забирать данные. У меня курсы нужных валют настроены в Яндексе, но удобнее всего получить из табличной части сайта http://www.phnet.ru/rates/, копируем этот адрес сайта и переходим:
Данные — Получить внешние данные — из Веба
Вставляем адрес сайта в адресную строку. IE может предложить использовать сценарии — отказываемся. Видим желтые стрелочки — жмем на нужную таблицу, которую хотим импортировать (первая картинка). Она станет зеленой
Ищем в правом нижнем углу — кнопку Импорт — кликаем. Появляется окно Импорт данных. Жмем свойства и добавляем галочку «обновление при открытии» — ок. Выбираем нужный диапазон — ок
Все, данные загрузились, они будут обновляться в фоновом режиме и при открытии данных.
К сожалению, если импорт возвращает ошибку «этот запрос не возвращает данные», в 90% случае вернуть данные не удастся.
Теперь на отдельном листе делаем красивые курсы валют и расчеты.
Неплохо получилось!
Пример можно скачать здесь.
Получить в Excel данные с сайта
Как вы поняли, так можно получить любые данные из интернета, будь то рейтинг нового фильма и температуру на улице.
Я например, еще сделал неплохой файл для себя где отобрал показатели, которые я часто проверяю. Удобно — все в одном месте.
Что еще?
Само собой можно придумать конструкцию с OpenXML или параметрический запрос. Но так же гораздо проще, согласитесь?:)
Внимательно следите за импортируемыми датами и временем! Очень часто эксель неверно воспринимает формат таких данных. Как быстро их перевести читайте здесь.
Само собой умельцы пишут много парсеров (программки для собирания данных по нескольким сайтам). Кому надо — пишите в комментарии, что-нить разыщу дельное!
Что логично, можно сделать и обратный обмен. Из таблицы в файле передавать данные при их изменении на сайт. Но это уже другая статья!
Поделитесь нашей статьей в ваших соцсетях:Похожие статьи
(Visited 6 497 times, 23 visits today)
Нельзя изменять часть массива. Ошибка Excelexcelworks.ru
Как перевести сумму или число прописью в Excel
Часто нужно перевести число в текст в Excel так, чтобы оно отображалось прописью (словами) на русском или других языках. Так как по умолчанию нет готовой функции, создадим свою пользовательскую функцию с помощью макросов.
Для создания пользовательской функции, которая сможет перевести число в текст прописью , нам нужно выполнить 3 простых шага:
- Открыть редактор макросов ALT+F11.
- Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».
- Вставить в модуль следующий код и сохранить:
Можно написать алгоритм макро программы по-другому и еще сделать так, чтобы она дописывала валюту суммы прописью. Для этого создайте Module2 и введите в него следующий код:
Function ЧислоПрописьюВалюта(SumBase As Double, Valuta As Integer) Dim Edinicy(0 To 19) As String: Dim EdinicyPoslednie(0 To 19) As String Dim Desyatki(0 To 9) As String: Dim Sotni(0 To 9) As String: Dim mlrd(0 To 9) As String Dim mln(0 To 9) As String: Dim tys(0 To 9) As String Dim SumInt, x, shag, vl As Integer: Dim txt, Sclon_Tys As String '--------------------------------------------- Application.Volatile '--------------------------------------------- Edinicy(0) = "": EdinicyPoslednie(0) = IIf(Valuta = 0, "евро", IIf(Valuta = 1, "рублей", "долларов")) Edinicy(1) = "один ": EdinicyPoslednie(1) = IIf(Valuta = 0, "один евро", IIf(Valuta = 1, "один рубль", "один доллар")) Edinicy(2) = "два ": EdinicyPoslednie(2) = IIf(Valuta = 0, "два евро", IIf(Valuta = 1, "два рубля", "два доллара")) Edinicy(3) = "три ": EdinicyPoslednie(3) = IIf(Valuta = 0, "три евро", IIf(Valuta = 1, "три рубля", "три доллара")) Edinicy(4) = "четыре ": EdinicyPoslednie(4) = IIf(Valuta = 0, "четыре евро", IIf(Valuta = 1, "четыре рубля", "четыре доллара")) Edinicy(5) = "пять ": EdinicyPoslednie(5) = IIf(Valuta = 0, "пять евро", IIf(Valuta = 1, "пять рублей", "пять долларов")) Edinicy(6) = "шесть ": EdinicyPoslednie(6) = IIf(Valuta = 0, "шесть евро", IIf(Valuta = 1, "шесть рублей", "шесть долларов")) Edinicy(7) = "семь ": EdinicyPoslednie(7) = IIf(Valuta = 0, "семь евро", IIf(Valuta = 1, "семь рублей", "семь долларов")) Edinicy(8) = "восемь ": EdinicyPoslednie(8) = IIf(Valuta = 0, "восемь евро", IIf(Valuta = 1, "восемь рублей", "восемь долларов")) Edinicy(9) = "девять ": EdinicyPoslednie(9) = IIf(Valuta = 0, "девять евро", IIf(Valuta = 1, "девять рублей", "девять долларов")) Edinicy(11) = "одиннадцать ": EdinicyPoslednie(11) = IIf(Valuta = 0, "одиннадцать евро", IIf(Valuta = 1, "одиннадцать рублей", "одиннадцать долларов")) Edinicy(12) = "двенадцать ": EdinicyPoslednie(12) = IIf(Valuta = 0, "двенадцать евро", IIf(Valuta = 1, "двенадцать рублей", "двенадцать долларов")) Edinicy(13) = "тринадцать ": EdinicyPoslednie(13) = IIf(Valuta = 0, "тринадцать евро", IIf(Valuta = 1, "тринадцать рублей", "тринадцать долларов")) Edinicy(14) = "четырнадцать ": EdinicyPoslednie(14) = IIf(Valuta = 0, "четырнадцать евро", IIf(Valuta = 1, "четырнадцать рублей", "четырнадцать долларов")) Edinicy(15) = "пятнадцать ": EdinicyPoslednie(15) = IIf(Valuta = 0, "пятнадцать евро", IIf(Valuta = 1, "пятнадцать рублей", "пятнадцать долларов")) Edinicy(16) = "шестнадцать ": EdinicyPoslednie(16) = IIf(Valuta = 0, "шестнадцать евро", IIf(Valuta = 1, "шестнадцать рублей", "шестнадцать долларов")) Edinicy(17) = "семнадцать ": EdinicyPoslednie(17) = IIf(Valuta = 0, "семнадцать евро", IIf(Valuta = 1, "семнадцать рублей", "семнадцать долларов")) Edinicy(18) = "восемнадцать ": EdinicyPoslednie(18) = IIf(Valuta = 0, "восемнадцать евро", IIf(Valuta = 1, "восемнадцать рублей", "восемнадцать долларов")) Edinicy(19) = "девятнадцать ": EdinicyPoslednie(19) = IIf(Valuta = 0, "девятнадцать евро", IIf(Valuta = 1, "девятнадцать рублей", "девятнадцать долларов")) ''--------------------------------------------- Desyatki(0) = "": Sotni(0) = "": tys(0) = "тисячь ": mln(0) = "миллионов ": mlrd(0) = "миллиардов " Desyatki(1) = "десять ": Sotni(1) = "сто ": tys(1) = "тысяча ": mln(1) = "миллион ": mlrd(1) = "миллиарда " Desyatki(2) = "двадцать ": Sotni(2) = "двести ": tys(2) = "тысячи ": mln(2) = "миллиона ": mlrd(2) = "миллиарда " Desyatki(3) = "тридцать ": Sotni(3) = "триста ": tys(3) = "тысячи ": mln(3) = "миллиона ": mlrd(3) = "миллиарда " Desyatki(4) = "сорок ": Sotni(4) = "четыреста ": tys(4) = "тысячи ": mln(4) = "миллиона ": mlrd(4) = "миллиарда " Desyatki(5) = "пятьдесят ": Sotni(5) = "пятьсот ": tys(5) = "тысяч ": mln(5) = "миллионов ": mlrd(5) = "миллиардов " Desyatki(6) = "шестьдесят ": Sotni(6) = "шестьсот ": tys(6) = "тысяч ": mln(6) = "миллионов ": mlrd(6) = "миллиардов " Desyatki(7) = "семьдесят ": Sotni(7) = "семьсот ": tys(7) = "тысяч ": mln(7) = "миллионов ": mlrd(7) = "миллиардов " Desyatki(8) = "восемьдесят ": Sotni(8) = "восемьсот ": tys(8) = "тысяч ": mln(8) = "миллионов ": mlrd(8) = "миллиардов " Desyatki(9) = "девяносто ": Sotni(9) = "девятьсот ": tys(9) = "тысяч ": mln(9) = "миллионов ": mlrd(9) = "миллиардов " '--------------------------------------------- On Error Resume Next SumInt = Int(SumBase) For x = Len(SumInt) To 1 Step -1 shag = shag + 1 Select Case x Case 12 ' - сотни миллиардов vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 11 ' - десятки миллиардов vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 10 ' - единицы миллиардов vl = Mid(SumInt, shag, 1) If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "мільярдів " Else txt = txt & Edinicy(vl) & mlrd(vl) 'числа в диапозоне от 11 до 19 склоняются на "мільярдов" независимо от последнего числа триады Else txt = txt & Edinicy(vl) & mlrd(vl) End If '-КОНЕЦ БЛОКА_______________________ Case 9 ' - сотни миллионов vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 8 ' - десятки миллионов vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 7 ' - единицы миллионов vl = Mid(SumInt, shag, 1) If shag > 2 Then If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10 End If If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "мільйонів " Else: txt = txt & Edinicy(vl) & mln(vl) 'числа в диапозоне от 11 до 19 склоняются на "мільярдов" независимо от последнего числа триады Else txt = txt & Edinicy(vl) & mln(vl) End If '-КОНЕЦ БЛОКА_______________________ Case 6 ' - сотни тысяч vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 5 ' - десятки тысяч vl = Mid(SumInt, shag, 1) If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 4 ' - единицы тысяч vl = Mid(SumInt, shag, 1) If shag > 2 Then If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10 End If Sclon_Tys = Edinicy(vl) & tys(vl) ' - вводим переменную Sclon_Tys из-за иного склонения тысяч в русском языке If vl = 1 Then Sclon_Tys = "одна " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys ) If vl = 2 Then Sclon_Tys = "дві " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys ) If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag - 1, 2)) & "тисяч " End If txt = txt & Sclon_Tys '-КОНЕЦ БЛОКА_______________________ Case 3 ' - сотни vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 2 ' - десятки vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 1 ' - единицы If Mid(SumInt, shag - 1, 1) <> 1 Or Mid(SumInt, shag - 1, 2) = "10" Then vl = Mid(SumInt, shag, 1) Else vl = Mid(SumInt, shag - 1, 2) txt = txt & EdinicyPoslednie(vl) '-КОНЕЦ БЛОКА_______________________ End Select 10: Next x a = SumBase b = Int(a) c = (a - b) * 100 If c = 0 Then c = CStr(c) + "0" d = "" If Valuta = 1 Then d = "коп." Else d = "цен." If Valuta > 2 Or Valuta < 0 Then MsgBox "Укажите параметр 0-2" If Valuta > 2 Or Valuta < 0 Then GoTo 11 ЧислоПрописьюВалюта = txt + " " + CStr(c) + d 11: End Function
Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:
- 1-рубли;
- 2-доллары;
- 0-евро;
Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).
Скачать число прописью в Excel.
Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.
exceltable.com
Лайфхак в Excel: как подгрузить курсы валют с сайта ЦБ
Немного больше 60 лет прошло с момента изобретения первого компьютера и около 50 лет с первых шагов по созданию интернета. Сейчас практически у каждого в кармане лежит мини-компьютер (смартфон) с доступом в сеть, уже начали появляться машины без водителя, некоторые и вовсе собираются колонизировать Марс. При этом большинство наших слушателей (работников финансовой сферы) до сих пор воспринимают Excel как красивый калькулятор. Мы решили помочь вам развить навыки использования этого важного инструмента, сделать из него настоящего помощника, а не просто хранителя данных.
Сегодня предлагаем вам посмотреть, как можно подгрузить данные из сети Интернет непосредственно в таблицу Excel и обработать их (создать функцию выбора курса валют на необходимую дату).
Для чего может понадобиться эта возможность?
Если вам регулярно необходим курс Центрального Банка РФ, то функция «Загрузка курса с сайта ЦБ» позволит сэкономить много времени.
Разбиваем задачу на две части:
(1) Автоматизируем загрузку курсов валют за необходимый период с сайта Центрального Банка России
(2) Пишем небольшой скрипт, который создаст «Пользовательскую функцию» для выбора курса на дату и предоставит его вставку в ячейку
(1) Загрузка курсов
Для решения данной задачи воспользуемся стандартным малоизвестным функционалом Excel.
(1.1) Линейка «Данные» --> «Получение внешних данных» --> «Из Интернета»:
 |
(1.2) В открывшемся браузере переходим на сайт ЦБ РФ и переходим на страницу с курсами:
 |
(1.3) Далее необходимо указать период для загрузки:
 |
(1.4) После получения данных нажмите кнопку «Импорт» и данные загрузятся в лист Excel (ВАЖНО! Не забудьте перед этим поставить галочку в небольшом квадратике вверху страницы. На рисунке выше он зеленого цвета). При этом в Excel будут загружены данные:
 |
(1.5) Если данные действия записать в виде макроса, то получим следующий скрипт в Visual Basic:
 |
Обратите внимание на выделенные элементы кода. Если вносить в них изменения и запускать код на выполнение - будем получать курсы за нужный период. И не придется каждый раз повторять операции описанные выше в пунктах (1.1-1.4).
Следующий шаг - написание скрипта, который будет выбирать из подгруженных данных курс на требуемую дату и будет возвращать его при помощи функции в ячейку.
(2) Создание функции «Выбор курса на дату».
Используем возможности создания «Пользовательских функций» в редакторе Visual Basic:
(2.1) Создаем процедуру для обработки данных. Проверяем корректность работы программы на процедуре. Найденное значение курса записывается в переменную kurs (см листинг ниже).
 |
(2.2) Меняем процедуру на функцию:
 |
(2.3) Вставляем в ячейку на листе с данными нашу функцию (ищите её в категории «Определенные пользователем»):
 |
 |
(2.4) «Растягиваем» ячейку с формулой на необходимый нам диапазон стандартным образом:
 |
Если у вас есть рутинные задачи, которые вы хотели бы автоматизировать, но не знаете как это сделать - пришлите их нашему эксперту по адресу [email protected]. Мы рассмотрим их в одной из следующих публикаций в нашем блоге. Наиболее интересные и сложные задачи будут включены в наш тренинг по Программированию в Excel, а их авторы получат ценные призы от нашей компании.
Если хотите научиться решать самостоятельно подобные задачи, отточить свои навыки по автоматизации рутинных задач - приходите на наш практический курс «Программирование в Excel для финансистов», который состоит из 2 частей: Базовый блок и Продвинутый блок. Занятия проходят по субботам.Базовый блок стартует 14 января 2017 г. Занятия в рамках Продвинутого блока начинаются 28 января 2017 г.
Записывайтесь на авторский курс Программирования в Excel.
Все статьи >>
Подписка на рассылки HOCK Taining
www.hocktraining.com
Курс доллара для любой заданной даты
Самые популярные в России курсы - это курсы валют. Правда, на них мало учат, зато много наказывают.
Если Вам часто приходится узнавать курс доллара для определенной заданной даты в прошлом (даты заказа или поставки, например), то этот макрос сэкономит вам много времени. Вместо похода в архивы ЦБР достаточно будет его запустить.
Откройте редактор Visual Basic, нажав ALT+F11 или выбрав в меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor), вставьте новый модуль (меню Insert - Module) и скопируйте туда текст этого макроса:
SSub GetDollar() 'объявляем переменные Dim sURI As String Dim oHttp As Object Dim htmlcode, outstr As String Dim inpdate As Date Dim d, m, y As Integer 'выводим диалоговое окно с вопросом о дате inpdate = CDate(InputBox("Введите дату в формате ДД.ММ.ГГГГ", _ "Курс доллара", Date)) 'разбираем дату на составляющие d = Format(inpdate, "dd") m = Format(inpdate, "mm") y = Format(inpdate, "yyyy") 'формируем строку для веб-запроса sURI = "http://cbr.ru/currency_base/daily.aspx?C_month=" & m & "&C_year=" _ & y & "&date_req=" & d & "%2F" & m & "%2F" & y 'делаем запрос On Error Resume Next Set oHttp = CreateObject("MSXML2.XMLHTTP") If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest") End If On Error GoTo 0 If oHttp Is Nothing Then Exit Sub End If oHttp.Open "GET", sURI, False oHttp.Send 'получаем HTML страницы с курсами и извлекаем из него курс доллара htmlcode = oHttp.responseText outstr = Mid(htmlcode, InStr(1, htmlcode, "USD") + 87, 7) Set oHttp = Nothing 'заменяем точку на запятую и выводим в активную ячейку outstr = Replace(outstr, ",", ".") ActiveCell.Value = outstr End SubТеперь, если закрыть редактор Visual Basic и вернуться в Excel, то через меню Сервис - Макрос - Макросы, или нажав ALT+F8, можно запустить наш макрос GetDollar, ввести в появившееся окно дату и получить курс доллара для заданной даты в текущей ячейке. Для удобства запуска можно сделать кнопку макроса на панели инструментов или на листе или назначить макросу сочетание клавиш.
Фактически, макрос загружает данные из архива сайта Центробанка РФ, поэтому для вставки курса в текущую ячейку необходимо иметь доступ в интернет (в данный момент). Данные вставляются как константы (без связи и обновления).
Для получения курса евро, иены, фунта и других валют необходимо сделать следующее:
- Открываете страницу сайта ЦБ со списком валют, обновляемых ежедневно за любую дату, например http://cbr.ru/currency_base/daily.aspx?C_month=10&C_year=2012&date_req=01.10.2012.
- Открываем исходный HTML-код запрошенной страницы (правой кнопкой по веб-странице - команда Просмотр HTML-кода в IE или что-то похожее в других браузерах) и ищем обозначение необходимой валюты, например USD.
- Считаем на сколько символов в исходнике от аббревиатуры валюты отстоит требуемый курс. Например, для доллара это 85, то есть с 85-го символа начинается числовое значение самого курса. Для евро = 81, для фунта = 96, для иены = 89, для швейцарского франка = 87 и т.д.
- Вставляем получившееся число и код валюты в макрос в строку outstr = Mid(htmlcode, InStr(1, htmlcode, "USD") + 87, 7)
Ссылки по теме
www.planetaexcel.ru
Как прописать сумму, число, цифры прописью в Excel
Очень распространенная задача написать числа прописью в Excel. Встроенной функции пока еще в Excel нет, поэтому мы можем создать пользовательскую функцию, которая и будет заменять цифры, числа текстом.
Как правило, это требуется в торговле, бухгалтерском учете и других сферах, где производятся расчеты с денежными средствами. Обычно необходимо перевести сумму в рублях и копейках прописью, как на картинке (первый пример).
Смотрите также: Как написать сумму прописью на украинском языке
Сумма в рублях, долларах или евро с копейками прописью
Допустим, мы делаем какие-то расчеты в таблице и получаем итоговую сумму в рублях 1526,23
Нам необходимо прописать эту цифру в рублях и желательно указать так же и копейки. Для этого создадим специальную универсальную пользовательскую функцию, которая будет выглядеть следующим образом
Propis (Amount;Money;lang;Prec)
где
Amount — это ссылка на ячейку с числом
Money — тут указывается вид валюты, можно указать рубли, доллары и евро («RUB», «USD», «EUR») — валюта обязательно указывается в кавычках.
lang — это язык на котором необходимо вывести сумму, доступно два языка английский и русский («EN», «RU») — так же указываем в кавычках
Prec — показывать (1) или не показывать (0) дробную часть
Таким образом, вы сможете прописать сумму в рублях, долларах или евро прописью русскими или английскими буквами вместе с дробной частью, при этом в зависимости от числа будет вставляться правильное окончание, например 2 рубля, 8 рублей, 1 рубль и так далее.
Чтобы создать пользовательскую функцию Propis, необходимо скопировать код, указанный ниже, далее нажмите ALT+F11, чтобы открыть VBA, добавьте новый пустой модуль через меню Insert — Module и вставьте туда скопированный код
Макрос пользовательской функции суммы прописью
Function Propis(Amount As String, Optional Money As String = "RUB", Optional lang As String = "RU", Optional Prec As Integer = 1) Dim whole As Double Amount = Replace(Amount, "-", Application.International(xlDecimalSeparator)) Amount = Replace(Amount, ".", Application.International(xlDecimalSeparator)) Amount = Replace(Amount, ",", Application.International(xlDecimalSeparator)) Sum = WorksheetFunction.Round(CDbl(Amount), 2) Money = UCase(Money) lang = UCase(lang) whole = Int(Sum) fraq = Format(Round((Sum - whole) * 100), "00") Select Case Class(whole, 1) + Class(whole, 2) * 10 Case 1, 21, 31, 41, 51, 61, 71, 81, 91 w_rus_r = "рубль" w_rus_d = "доллар" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94 w_rus_r = "рубля" w_rus_d = "доллара" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" Case Else w_rus_r = "рублей" w_rus_d = "долларов" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" End Select Select Case fraq Case 1, 21, 31, 41, 51, 61, 71, 81, 91 f_rus_r = "копейка" f_rus_d = "цент" f_rus_e = "цент" f_rus_p = "сотая" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" f_en_e = "cents" Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94 f_rus_r = "копейки" f_rus_d = "цента" f_rus_e = "цента" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" Case Else f_rus_r = "копеек" f_rus_d = "центов" f_rus_e = "центов" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" End Select If Prec = 0 Then fraq = "" f_rus_r = "" f_rus_d = "" f_rus_e = "" f_en_r = "" f_en_d = "" f_en_e = "" End If If lang = "RU" Then Select Case Money Case "RUB" Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r Case "USD" Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d Case "EUR" Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e End Select End If If lang = "EN" Then Select Case Money Case "RUB" Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r Case "USD" Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d Case "EUR" Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e End Select End If Propis = WorksheetFunction.Trim(Out) End Function Private Function Class(m, i) Class = Int(Int(m - (10 ^ i) * Int(m / (10 ^ i))) / 10 ^ (i - 1)) End Function Private Function ScriptRus(n As Double) As String Dim Nums1, Nums2, Nums3, Nums4 As Variant Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ") Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ") Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ") If n = 0 Then ScriptRus = "Ноль" Exit Function End If ed = Class(n, 1) dec = Class(n, 2) sot = Class(n, 3) tys = Class(n, 4) dectys = Class(n, 5) sottys = Class(n, 6) mil = Class(n, 7) decmil = Class(n, 8) sotmil = Class(n, 9) mlrd = Class(n, 10) If mlrd > 0 Then Select Case mlrd Case 1 mlrd_txt = Nums1(mlrd) & "миллиард " Case 2, 3, 4 mlrd_txt = Nums1(mlrd) & "миллиарда " Case 5 To 20 mlrd_txt = Nums1(mlrd) & "миллиардов " End Select End If If (sotmil + decmil + mil) > 0 Then sotmil_txt = Nums3(sotmil) Select Case decmil Case 1 mil_txt = Nums5(mil) & "миллионов " GoTo www Case 2 To 9 decmil_txt = Nums2(decmil) End Select Select Case mil Case 1 mil_txt = Nums1(mil) & "миллион " Case 2, 3, 4 mil_txt = Nums1(mil) & "миллиона " Case 0, 5 To 20 mil_txt = Nums1(mil) & "миллионов " End Select End If www: sottys_txt = Nums3(sottys) Select Case dectys Case 1 tys_txt = Nums5(tys) & "тысяч " GoTo eee Case 2 To 9 dectys_txt = Nums2(dectys) End Select Select Case tys Case 0 If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч " Case 1 tys_txt = Nums4(tys) & "тысяча " Case 2, 3, 4 tys_txt = Nums4(tys) & "тысячи " Case 5 To 9 tys_txt = Nums4(tys) & "тысяч " End Select If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч " eee: sot_txt = Nums3(sot) Select Case dec Case 1 ed_txt = Nums5(ed) GoTo rrr Case 2 To 9 dec_txt = Nums2(dec) End Select ed_txt = Nums1(ed) rrr: ScriptRus = mlrd_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt ScriptRus = UCase(Left(ScriptRus, 1)) & LCase(Mid(ScriptRus, 2, Len(ScriptRus) - 1)) End Function Private Function ScriptEng(ByVal Number As Double) Dim BigDenom As String, Temp As String Dim Count As Integer ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " strAmount = Trim(Str(Int(Number))) Count = 1 Do While strAmount <> "" Temp = GetHundreds(Right(strAmount, 3)) If Temp <> "" Then BigDenom = Temp & Place(Count) & BigDenom If Len(strAmount) > 3 Then strAmount = Left(strAmount, Len(strAmount) - 3) Else strAmount = "" End If Count = Count + 1 Loop Select Case BigDenom Case "" BigDenom = "Zero " Case "One" BigDenom = "One " Case Else BigDenom = BigDenom & " " End Select ScriptEng = BigDenom End Function Private Function GetHundreds(ByVal MyNumber) Dim result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) If Mid(MyNumber, 1, 1) <> "0" Then result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If If Mid(MyNumber, 1, 1) <> "0" And (Mid(MyNumber, 2, 1) <> "0" Or Mid(MyNumber, 3, 1) <> "0") Then result = result & "And " End If If Mid(MyNumber, 2, 1) <> "0" Then result = result & GetTens(Mid(MyNumber, 2)) Else result = result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = result End Function Private Function GetTens(TensText) Dim result As String result = "" If Val(Left(TensText, 1)) = 1 Then Select Case Val(TensText) Case 10: result = "Ten" Case 11: result = "Eleven" Case 12: result = "Twelve" Case 13: result = "Thirteen" Case 14: result = "Fourteen" Case 15: result = "Fifteen" Case 16: result = "Sixteen" Case 17: result = "Seventeen" Case 18: result = "Eighteen" Case 19: result = "Nineteen" Case Else End Select Else Select Case Val(Left(TensText, 1)) Case 2: result = "Twenty " Case 3: result = "Thirty " Case 4: result = "Forty " Case 5: result = "Fifty " Case 6: result = "Sixty " Case 7: result = "Seventy " Case 8: result = "Eighty " Case 9: result = "Ninety " Case Else End Select result = result & GetDigit _ (Right(TensText, 1)) End If GetTens = result End Function Private Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End FunctionИтак, функция создана, чтобы воспользоваться ей, просто введите ячейке Propis с нужными аргументами, например, если нам необходимо прописать сумму прописью в рублях с копейками и на русском языке, то формула будет выглядеть следующим образом.
=Propis(B2;"RUB";"RU";1)
Числа прописью с копейками заглавными или строчными буквами в Excel
Вот код VBA для пользовательской функции. Отображение суммы прописью с копейками и выбором первой заглавной или строчной буквы
Function РубПропись(Сумма As Double, Optional Без_копеек As Boolean = False, _ Optional КопПрописью As Boolean = False, Optional начинитьПрописной As Boolean = True) As String 'Функция для написания суммы прописью Dim ed, des, sot, ten, razr, dec Dim i As Integer, str As String, s As String Dim intPart As String, frPart As String Dim mlnEnd, tscEnd, razrEnd, rub, cop dec = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") ten = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ") des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ") sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ") razr = Array("", "тысяч", "миллион", "миллиард") mlnEnd = Array("ов ", " ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ") tscEnd = Array(" ", "а ", "и ", "и ", "и ", " ", " ", " ", " ", " ") razrEnd = Array(mlnEnd, mlnEnd, tscEnd, "") rub = Array("рублей", "рубль", "рубля", "рубля", "рубля", "рублей", "рублей", "рублей", "рублей", "рублей") cop = Array("копеек", "копейка", "копейки", "копейки", "копейки", "копеек", "копеек", "копеек", "копеек", "копеек") If Сумма >= 1000000000000# Or Сумма < 0 Then РубПропись = CVErr(xlErrValue): Exit Function '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If Round(Сумма, 2) >= 1 Then intPart = Left$(Format(Сумма, "000000000000.00"), 12) For i = 0 To 3 s = Mid$(intPart, i * 3 + 1, 3) If s <> "000" Then str = str & sot(CInt(Left$(s, 1))) If Mid$(s, 2, 1) = "1" Then str = str & ten(CInt(Right$(s, 1))) Else str = str & des(CInt(Mid$(s, 2, 1))) & IIf(i = 2, dec(CInt(Right$(s, 1))), ed(CInt(Right$(s, 1)))) End If On Error Resume Next str = str & IIf(Mid$(s, 2, 1) = "1", razr(3 - i) & razrEnd(i)(0), _ razr(3 - i) & razrEnd(i)(CInt(Right$(s, 1)))) On Error GoTo 0 End If Next i str = str & IIf(Mid$(s, 2, 1) = "1", rub(0), rub(CInt(Right$(s, 1)))) End If РубПропись = str '''''''''''''''''' If Без_копеек = False Then frPart = Right$(Format(Сумма, "0.00"), 2) If frPart = "00" Then frPart = "" Else If КопПрописью Then frPart = IIf(Left$(frPart, 1) = "1", ten(CInt(Right$(frPart, 1))) & cop(0), _ des(CInt(Left$(frPart, 1))) & dec(CInt(Right$(frPart, 1))) & cop(CInt(Right$(frPart, 1)))) Else frPart = IIf(Left$(frPart, 1) = "1", frPart & " " & cop(0), frPart & " " & cop(CInt(Right$(frPart, 1)))) End If End If РубПропись = str & " " & frPart End If '''''''''''''''''' ' РубПропись = str & frPart If начинитьПрописной Then Mid$(РубПропись, 1, 1) = UCase(Mid$(РубПропись, 1, 1)) ' If начинитьПрописной Then РубПропись = UCase(Left(РубПропись, 1)) & Mid(РубПропись, 2) End Function- Без копеек (1), с копейками (0)
- Копейки прописью (1), числом (0)
- Начинать прописью (0), заглавной (1)
Вот как используется функция
Примечание
- Данная функция будет работать с числами от 0 до 99 999 999
- Перед копирование кода переключите раскладку клавиатуры на русский язык (для корректного копирования русского текста)
- Код VBA необходимо вставлять во все файлы (Книги Excel), где вы хотите, чтобы она работала
- После вставки код, необходимо сохранить файл с поддержкой макросов xlsm (в Excel, начиная с 2007 версии)
- Функцию можно либо набирать в ручную, либо, если вы забыли как она пишется, через мастер функций (кнопка fx в строке формул, категория Определенные пользователем)
sirexcel.ru
