Цена товаров

@timsc1 · Регистрация: 27.11.2011

Author24 — интернет-сервис помощи студентам

Доброго времени суток, уважаемые профессионалы!!! Есть задачка: прилагаю файл ёкселя 2010. На листе список товаров и цены, у кого в долларах, у кого в евро. Кнопку на лист добавил. Нужен макрос, который выбирает товары из списка с ценой по долларам и записывает их в отдельный лист "Цена в долларах" и считает общую сумму. Также выбирает товары с ценой в евро, записывает их в лист "Цена в евро" и считает общую сумму. Формат чисел обыкновенно денежный ($ США и 123 евро). Возможно ли программно различить денежные форматы в ячейках??? Помогите пожалуйста с макросом!!! Заранее Спасибо!!!

@Igor_Tr · 02.09.2013, 23:43

Я просто поигрался рекордером и форматами. Но, думаю, лучше бы попробовать FindFormat. А в общем - смотрите.

@timsc1 · 03.09.2013, 08:13 **[ТС]**

Спасибочки огромное!!!

Теперь осталось их в рахные листы записать. Дай Вам БОГ здоровья!!!

Добавлено через 7 минут
А как сделать, чтобы он посчитал общую сумму по долларам и по евро???

@Igor_Tr · 03.09.2013, 10:15

Если чуть изменить фортмат, тогда код будет не работать. Поэтому я изменил - теперь он реагирует не на конкретный формат, а на символы доллара и евро. Так надежней. Добавил Вам суммы. Но, думаю, лучше на нужных листах UsedRange просто преобразовать в ListObject. Ну а по листам сами разнесете, главное, что у Вас все в массивах. Тут просто рутина. Проверить, есть/нет такой лист (товар в дол., товар в евро), если нет - создать и вставить на него нужный массив в нужное место. Если есть - очистить полностю и вставить на него нужный массив в нужное место. И так два раза.

А так - старый код замените полностью этим.

Кликните здесь для просмотра всего текста

Visual Basic

Sub MyFinFormat()
Dim euro(), dollar(), i&, j&, mSTR$, cC As Range
   ReDim euro(1 To Range([b4], Cells(Rows.Count, 2).End(xlUp)).Rows.Count, 1 To 2)
   ReDim dollar(1 To Range([b4], Cells(Rows.Count, 2).End(xlUp)).Rows.Count, 1 To 2)
   i = 0: j = 0
      For Each cC In Range([b4], Cells(Rows.Count, 2).End(xlUp))
         If InStr(1, cC.NumberFormat, Chr(36) & Chr(36), vbTextCompare) <> 0 Then
            i = i + 1: dollar(i, 1) = cC.Offset(0, -1).Value: dollar(i, 2) = cC.Value
         End If
          If InStr(1, cC.NumberFormat, Chr(136), vbTextCompare) <> 0 Then
            j = j + 1: euro(j, 1) = cC.Offset(0, -1).Value: euro(j, 2) = cC.Value
         End If
      Next
   [b4].Offset(0, 2).Resize(UBound(dollar, 1), 2).Value = dollar
   Range([b4].Offset(0, 3), Cells(Rows.Count, _
         [b4].Offset(0, 3).Column).End(xlUp)).NumberFormat = "[$$-409]#,##0"
 '--sum--Dollars------------------------------------------
   With [b4].Offset(0, 3).End(xlDown)
      .Offset(2, -1).Value = "Sum 1"
      .Offset(2, 0).NumberFormat = "[$$-409]#,##0"
      .Offset(2, 0).Value = Application.Sum(Range([b4].Offset(0, 3), Cells(Rows.Count, _
         [b4].Offset(0, 3).Column).End(xlUp)))
   End With
'==End==sum==Dollars============================
   [b4].Offset(0, 5).Resize(UBound(euro, 1), 2).Value = euro
   Range([b4].Offset(0, 6), Cells(Rows.Count, _
         [b4].Offset(0, 6).Column).End(xlUp)).NumberFormat = "#,##0 [$ˆ-1]"
 '--sum--EURO------------------------------------------
    With [b4].Offset(0, 6).End(xlDown)
      .Offset(2, -1).Value = "Sum 2"
      .Offset(2, 0).NumberFormat = "#,##0 [$ˆ-1]"
      .Offset(2, 0).Value = Application.Sum(Range([b4].Offset(0, 6), Cells(Rows.Count, _
         [b4].Offset(0, 6).Column).End(xlUp)))
   End With
'==End==sum==EURO============================
End Sub

@timsc1 · 03.09.2013, 13:20 **[ТС]**

@Igor_Tr · 03.09.2013, 17:46

Мне уже мое сегодня надоело. Отвлекаюсь, игрался с Вашим. Пробуйте так.

@timsc1 · 03.09.2013, 19:24 **[ТС]**

Дай Вам БОГ здоровья!!! Буду помаленьку разбираться!!! Спасибо Вам ещё раз!!!

@Igor_Tr · 03.09.2013, 19:41

А что там разбираться. Что б было легче, разбил на блоки (зеленые коменты). Единственное, если нужно сортрировку, тогда сразу после фразы

.ListObjects("TableEURO").ShowTotals = True

вставьте:

Visual Basic

1
2
3

With .Range("TableEURO")
   .Sort .Cells(1), xlAscending, , Header:=xlYes
End With

и, соотверственно, после фразы

.ListObjects("TableDOLLAR").ShowTotals = True

вставьте это, аналогичное предыдущему:

Visual Basic

1
2
3

With .Range("TableDOLLAR")
   .Sort .Cells(1), xlAscending, , Header:=xlYes
End With

И рекомендую больше времени приделить ListObjects. Интересный инструмент.

Удачи.

@timsc1 14 / 14 / 2 Регистрация: 27.11.2011 Сообщений: 697
	03.09.2013, 08:13 [ТС]	3
	Спасибочки огромное!!! Теперь осталось их в рахные листы записать. Дай Вам БОГ здоровья!!! Добавлено через 7 минут А как сделать, чтобы он посчитал общую сумму по долларам и по евро??? 0

@timsc1 14 / 14 / 2 Регистрация: 27.11.2011 Сообщений: 697
	03.09.2013, 13:20 [ТС]	5
	0

@timsc1 14 / 14 / 2 Регистрация: 27.11.2011 Сообщений: 697
	03.09.2013, 19:24 [ТС]	7
	Дай Вам БОГ здоровья!!! Буду помаленьку разбираться!!! Спасибо Вам ещё раз!!! 0

	03.09.2013, 19:41