Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Помощь в написании макроса

Автор: Mrak 8.11.2004, 09:31

Для начала - здравствуйте!
У меня вот такой вопрос.
Допустим у нас есть столбец под названием "Платеж". Т.е. поступающие в различной валюте платежи расположены в одном столбце. Для примера - две валюты ($ и Руб). Рядом есть два столбца (Рублевые платежи и долларовые платежи). Надо написать макрос, чтобы платежи из общего списка раскидывались по соответствующим своей валюте и считалась общая сумма платежа в каждой валюте.
Поможете?

Автор: Cashey 8.11.2004, 12:52

А как идентифицируется валюта с столбце "Платеж"? Указание типа валюты должно присутствовать в той же колонке или в соседней. А иначе как понять в какой валюте указана сумма?

Автор: Mrak 9.11.2004, 08:46

Рубли - р.
Доллары - знак $ в конце суммы платежа. И эти суммы расположены друг под другом в разном порядке.

Автор: Cashey 9.11.2004, 21:13

Тогда надо брать строку, определять в ней пробел, первый с конца, отчленять символы признака валюты и анализировать их. А потом разносить согласно этим признакам. Работать со строками умеешь?

Автор: Mrak 10.11.2004, 08:12

Понимаешь, в чем проблема, у меня получилось разогнать платежи в разных валютах по столбцам с помощью автофильтра. То есть пишем макрос, использующий автофильтр и все отлично - получаются два столбца с разной валютой. Но посчитать сумму в таких случаях не удастся, так как данные в ячейках в таком случае текстовые. Путем ПСТР и Значен их можно преобразовать в числовые и просуммировать. У меня так получилось и все прекрасно, за исключением одного, остаются столбцы с этими самыми преобразованиями.
Изначально-то конечно хотелось, чтобы в ячейках с соответствующей валютой был задан денежный формат. Но вот как фильтровать в этом случае - не понимаю.

Автор: Guest 10.11.2004, 12:34

А что если для расчетов параллельно сделать скрытые столбцы.

Автор: Guest 10.11.2004, 12:35

Старуха

Автор: Mrak 11.11.2004, 07:32

Цитата(Guest @ 10.11.2004, 12:34)

А что если для расчетов параллельно сделать скрытые столбцы.

Было бы отлично, если бы знать как? Я не знаю, где это установить.

Автор: Гость_Старуха 11.11.2004, 13:11

А таблица в какой -то программе (может в xl)?

Автор: Гость_Старуха 11.11.2004, 15:28

Цитата

ПСТР и Значен

-Похоже ты в xl.
Формат-Столбец-Скрыть
И еще
=C1&"$" может пригодиться.(к значению в С1 прицепить знак доллара)

Автор: Mrak 12.11.2004, 07:46

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

Автор: Гость_Старуха 12.11.2004, 09:58

Я сделаю сегодня.Может отправить не получится с работы .Тогда вечером из дома отправлю.

Автор: Гость_Старуха 12.11.2004, 14:44

Это если на одном листе делать

Код


Private Sub CommandButton1_Click()
Dim a As String
d = Лист1.UsedRange.Rows.Count
For rwIndex = 1 To d '2 - начальная строчка, d - конечная
Range("C" & rwIndex).Value = Mid((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text) - 2), 3)
'отсекаем Руб(У тебя так написано)
If Range("C" & rwIndex).Value = "Руб" Then
'если ячейка в D равна Руб
Range("D" & rwIndex).Value = Left((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text) - 2) - 1)
'будет число
Range("E" & rwIndex).Value = 0
'будет ноль
Else
'если ячейка в D не равна Руб
Range("E" & rwIndex).Value = Left((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text)) - 1)
Range("D" & rwIndex).Value = 0
End If
Next
End Sub

Автор: Staruha 14.11.2004, 11:43

Запрос на выборку.Исполняется впервые.
Вобщем этот код рааскидывает по листам

Код


Private Sub CommandButton1_Click()

 Лист2.Columns("A:B").ClearContents 'Очищаем листы
 Лист3.Columns("A:C").ClearContents

d = Лист1.UsedRange.Rows.Count

For rwIndex = 1 To d 


Range("D" & rwIndex).Value = Mid((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text) - 2), 3)
'Отсекаем руб
If Range("D" & rwIndex).Value = "Руб" Then
Range("B" & rwIndex).Value = Left((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text) - 2) - 1)
Range("C" & rwIndex).Value = 0
 Лист2.Range("A2", "B2").Value = Range("A" & rwIndex, "B" & rwIndex).Value
Лист2.Rows("2").Insert Shift:=xlDown

Else
Range("C" & rwIndex).Value = Left((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text)) - 1)
Range("B" & rwIndex).Value = 0
Лист3.Range("A2", "C2").Value = Range("A" & rwIndex, "C" & rwIndex).Value
Лист3.Rows("2").Insert Shift:=xlDown
End If
Next
   Лист3.Columns("B").Delete Shift:=xlToLeft 'Удаляем столбец
'Лист3.Columns("B").Hidden = True 'Так потом скроешь столбцы
End Sub

Автор: Mrak 14.11.2004, 12:32

Огромное спасибо!! smile

. Все работает отлично. Эх, жаль что нельзя поднять репутацию. Значит еще раз спасибо smile

)

Автор: Guest 14.11.2004, 15:51

На этом форуме мне тоже коды писали , потом ты кому нибудь напишешь.Вот это будет самое большое спасибо smile

Автор: Staruha 14.11.2004, 15:54

Этоя была я.Забываю проверить регистрацию

Автор: Staruha 14.11.2004, 21:48

Ты писал что у тебя несколько видов Валюты. Этот код найдет любую ,которую ты введешь в ячейку I1.

Код


Private Sub CommandButton1_Click()
Dim a As Integer
a = Len(Range("I1").Value)
Dim c As Integer
Dim d As Integer
 
 Лист2.Columns("A:B").ClearContents 'очищаем Лист 2
d = Лист1.UsedRange.Rows.Count

For rwIndex = 1 To d
c = Len(Range("A" & rwIndex).Text) - a 'кол.символов без валюты

Range("B" & rwIndex).Value = Left((Range("A" & rwIndex).Text), c)
Range("C" & rwIndex).Value = Mid((Range("A" & rwIndex).Text), (Len(Range("A" & rwIndex).Text) - a + 1), a)
'отсекаем денюшку
If Range("C" & rwIndex).Value = Range("I1").Value Then
'если ячейка в C равна значению в ячейке I1
 Лист2.Range("A2", "B2").Value = Range("A" & rwIndex, "B" & rwIndex).Value
Лист2.Rows("2").Insert Shift:=xlDown
'Лист2.Columns("B").Hidden = True 'Потом скроешь столбец

End If
Next
End Sub

Можно еще фильтровать список на месте.Смотри в FAQе для VB скрытие строк.

Автор: Cashey 16.11.2004, 21:33

Перенесено из MS Office, по просьбе cardinal