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

[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]

...как мне вытащить название валюты из формата ячейки, чтобы импортировать в нужную колонку в программе?

Код Выделить Развернуть

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

[Leviathan]

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

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