Макросы в Excel !

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Привет всем! Прошу помочь у тех кто умеет прогармировать на VBA. У меня такая ситуация, предположим што у меня есть в Листе1 список товаров которие предлогает компания.Там есть такие ячейки "название"," цена", "заказ (ето я задаю скока надо купить)" і сума заказа. Мне надо создать макрос которий будет опридилять когда в одной из ячеек ЗАКАЗ значение будет больше 1, и переносить дание которие относятся к етому товару на Лист2, а где 0 то ничево с ней не делать.
Лист1
Название цена Заказ Сума
Комп 1000 1 1000
Комп2 2000 0 2000
Комп3 3000 2 3000

Лист2
Комп 1000 1000
Комп3 3000 3000
:confused:
BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Люди, мне очень надо етово макроса, почему никто не пишет. Мне нужен хоть какой то совет!
Аватара пользователя
Naeel Maqsudov
Сообщения: 2570
Зарегистрирован: 20 фев 2004, 19:17
Откуда: Moscow, Russia
Контактная информация:

Макросы тут не нужны.
Воспользуйтесь меню Данные/Фильтр
BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Нужно это сделать объязательно с помощью макроса.
Аватара пользователя
Naeel Maqsudov
Сообщения: 2570
Зарегистрирован: 20 фев 2004, 19:17
Откуда: Moscow, Russia
Контактная информация:

Код: Выделить всё

Sub qwe()
Dim row As Range, sh As Worksheet, V As Variant, N As Long
  Set sh = Application.ActiveWorkbook.Sheets("Лист2")
  N = Application.WorksheetFunction.Count(sh.Columns(1)) + 1
  For Each row In Application.ActiveWorkbook.Sheets("Лист1").Cells(1, 1).CurrentRegion.Rows
    V = row.Cells(1, 3).Value
    If IsNumeric(V) And V >= 1 Then row.Copy sh.Cells(N, 1): N = N + 1
  Next
  Set sh = Nothing
End Sub
BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Большое спасибо, шас иду макрос к файлу прикручевать.

А еще вопрос, возможно ли сделать следуюющее с помощю макроса??
"если сума в ячейке будет превишать, припустим "10", штоб макрос откривал небольшою картинку(анимацию) и звук с жорс.диска?"

если возможно то помогите, но тоже с помощью макроса. Наперед спасибо

---------- Post added at 13:22 ---------- Previous post was Вчера at 16:53 ----------

Значит такого сделать невозможно или как:??
Аватара пользователя
Naeel Maqsudov
Сообщения: 2570
Зарегистрирован: 20 фев 2004, 19:17
Откуда: Moscow, Russia
Контактная информация:

Можно.
Смотрите функцию Shell в справке.
Shell Function

Runs an executable program and returns a Variant (Double) representing the program's task ID if successful, otherwise it returns zero.

Syntax:
Shell(pathname[,windowstyle])
BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Спасибо за макрос, он прекрасно работает. Но есть еще один вопрос, возможно тот самий макрос сделать ыним образом. Мне нужно еще 3 екземляра етого макроса но штоб он отличался чем то. Если возможно то пліз сделайте, хоть один или 2 способ. Заранее спасибо! Мне очень очень нужно
Аватара пользователя
mc-black
Сообщения: 250
Зарегистрирован: 08 май 2008, 16:09
Откуда: Россия, Нижний Новгород
Контактная информация:

Зачем это нужно? Создайте еще 2 копии макроса, дайте процедурам другие имена, сошлитесь на листы с другими именами.. Что за необходимость?

Код: Выделить всё

Sub rty()
Dim row As Range, sh As Worksheet, V As Variant, N As Long
  Set sh = Application.ActiveWorkbook.Sheets("Лист4")
  N = Application.WorksheetFunction.Count(sh.Columns(1)) + 1
  For Each row In Application.ActiveWorkbook.Sheets("Лист3").Cells(1, 1).CurrentRegion.Rows
    V = row.Cells(1, 3).Value
    If IsNumeric(V) And V >= 1 Then row.Copy sh.Cells(N, 1): N = N + 1
  Next
  Set sh = Nothing
End Sub
На заказ: VBA, Excel mc-black@yandex.ru
BigGonschik
Сообщения: 11
Зарегистрирован: 18 мар 2009, 20:44

Привет еще раз. макрос просто супер. Можна еще как то по подробнее со звуком і картинкой? А то ничев оне понял с поста про функцию Shell. Мне нужно если в Листе1, в ячейке K10 значение буде больше 10, тогда открить звук которий есть в той папке што и файл?если можно напишети код?спасибо
--------------------------------------------------------------------------------
Добавленное сообщение
--------------------------------------------------------------------------------
Нашел такое, дял воспроизведение звука, но не работает. Почему незнаю.

Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
Function ALARM(Cell, Condition)
Dim WAVFile As String
Const SND_ASYNC = &H1
Const SND_FILKNAME = &H20000
If Evaluate(Cell.Value & Condition) Then
WAVFile = ThisWorkbook.Path & "\sound.wav"
Call PlaySound(WAVFile, Ob, SND_ASYNC Or SND_FILENAME|
ALARM = True
Else
ALARM = False
End If
End Function

как мне сделать, штоб оно воспроизвело мой файл?? исправте, где надо

и еще один вопрос, нужно очистить содержимое Лист2, пробивал таким способом:

Sub My()
Active Sheet. Range (xx:xx) Clear
end sub.

и ето тоже не работает, почему??исправте тоже. Еще вопрос, почему у меня после компиляции появляется такая желтая стрелочка слева??што она делает?
Наперед Большое спасибо !
Ответить