Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Валюта при автоматической обработке прайс-листов Excel

Автор Leviathan, 02.01.2016, 14:43

« назад - далее »

Leviathan

Добрый день. Возникла задача с обработкой цен в мультивалютном прайсе, в котором валюта задана не отдельной колонкой или числовым курсом, а как формат ячейки. В итоге при загрузке прайса в программу прайс-агрегатор цена попадает как простое число без признака валюты.

Перед началом загрузки в правилах импорта я могу указать текст любого макроса который выполнит какую-то дополнительную обработку в книге Эксель. Собственно вопрос - как мне вытащить название валюты из формата ячейки, чтобы импортировать в нужную колонку в программе.



Т.е. для закачки прайса в эту программу для анализа, курс валюты или валюта должна идти отдельной колонкой в прайс-листе. Как мне заполнить эту колонку макросом из формата ячейки с ценой?

vikttur

В общий модуль:
Sub FormatPrice()
Dim ArrPrice
Dim lRws As Long
Dim i As Long
    With Worksheets("TDSheet") ' на листе
        lRws = .Cells(.Rows.Count, "E").End(xlUp).Row ' последгяя строка с данными
        If lRws < 5 Then Exit Sub ' если данных нет, выходим
        ArrPrice = .Range("E1:E" & lRws).Value ' цены в массив
   
   
    For i = 5 To lRws ' проходим по строкам
        Select Case .Range("E" & i).NumberFormat ' сверяем формат ячейки
            Case "0.00"" USD""" '  формат - USD
                ArrPrice(i, 1) = ArrPrice(i, 1) * 70 ' значение*курс=рублей
            Case "0.00"" EUR""" '  формат - EUR
                ArrPrice(i, 1) = ArrPrice(i, 1) * 85
        End Select
    Next i
   
    .Range("G1").Resize(lRws, 1).Value = ArrPrice ' выгрузка преобразованных цен

    End With
End Sub

Serge 007

Цитата: Leviathan от 02.01.2016, 14:43...как мне вытащить название валюты из формата ячейки, чтобы импортировать в нужную колонку в программе?
Sub Leviathan()
    Dim rVal As Range
        For Each rVal In Range("c5:c" & Cells(Rows.Count, 3).End(xlUp).Row)
            rVal.Offset(, 4) = Mid(rVal.NumberFormat, 7, 3)
        Next rVal
End Sub
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

Leviathan

#3
Serge 007, спасибо огромное, этот макрос мне подошел даже больше, потому как после чтения прайса программа автоматом забирает валюту с сайта ЦБР и записывает sql запросом в колонки для соответствующих валют. Только его пришлось по аналогии переделать и для цены РРЦ

ЦитироватьSub iNETsHOP_import()
    Dim rVal As Range
        For Each rVal In Range("c5:c" & Cells(Rows.Count, 3).End(xlUp).Row)
            rVal.Offset(, 4) = Mid(rVal.NumberFormat, 7, 3)
        Next rVal

        For Each rVal In Range("e5:e" & Cells(Rows.Count, 5).End(xlUp).Row)
            rVal.Offset(, 3) = Mid(rVal.NumberFormat, 7, 3)
        Next rVal
End Sub

Теперь получилось как надо: