Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск непустых ячеек. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск непустых ячеек. (Макросы Sub)
Поиск непустых ячеек.
Vintik-ok Дата: Понедельник, 17.02.2014, 11:04 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Всем привет! До того как увидел Ваш форум, старался обходится тем что откопаю в просторах интернета. Но мне понравилось то, насколько качественно решаются проблемы форумчан. Поэтому решил обратиться и со своей проблемой к Вам, дабы облегчить себе поставленную задачу. Прошу строго не судить, начал изучать VB в excel лишь последние 4 дня(и вообще VB в целом, не надо было спать на лекциях), волшебным пенделем в решении этой проблемы для меня будет ответ на всего лишь один вопрос, но проблему опишу подробно в спойлере если вдруг кому-то станет интересно yes

Мне нужно присвоить значение первой найденной не пустой ячейки к переменной, чтобы уже её перенести в другую таблицу. Ячейки из столбца J на листе "Выгрузка" И каждую последующую найденную ячейку переносить в последующую строку на листе "Общая" как i=i+1 в определенный столбец D начиная со строки 15.
Я пытался сделать это через ПОИСКПОЗ, но видимо не могу додумать как это все правильно использовать(мучаюсь 4-ый день).


вот тут код к кнопке ActiveX

[vba]
Код
Option Explicit
Private Sub CommandButton1_Click()

Dim cName, i, cell, cDateCur
cDateCur = ("Жильцы") 'значение ячейки которое мы ищем.

Application.ScreenUpdating = False
i = 10
For Each cName In Array("Общая") 'Тут можно задать целый список/массив страниц на которых будет проводится поиск
For Each cell In Intersect(Sheets(cName).Columns("A"), Sheets(cName).UsedRange)
If cell.Value = cDateCur Then
cell.EntireRow.Copy
Cells(i, 1).PasteSpecial (xlValues) 'чтобы формулы не потекли, вставляем только значения найденных ячеек
i = i + 1
End If
Next
Next
cDateCur = ("Застройщики")
i = 30
For Each cName In Array("Общая")
For Each cell In Intersect(Sheets(cName).Columns("A"), Sheets(cName).UsedRange)
If cell.Value = cDateCur Then
cell.EntireRow.Copy
Cells(i, 1).PasteSpecial (xlValues)
i = i + 1
End If
Next
Next
Application.ScreenUpdating = True

End Sub
[/vba]
К сообщению приложен файл: 4433693.xlsm (28.1 Kb)


Из любого вопроса можно сделать огромную проблему, главное уметь неправильно задавать вопросы.

Сообщение отредактировал Serge_007 - Вторник, 18.02.2014, 00:05
 
Ответить
СообщениеВсем привет! До того как увидел Ваш форум, старался обходится тем что откопаю в просторах интернета. Но мне понравилось то, насколько качественно решаются проблемы форумчан. Поэтому решил обратиться и со своей проблемой к Вам, дабы облегчить себе поставленную задачу. Прошу строго не судить, начал изучать VB в excel лишь последние 4 дня(и вообще VB в целом, не надо было спать на лекциях), волшебным пенделем в решении этой проблемы для меня будет ответ на всего лишь один вопрос, но проблему опишу подробно в спойлере если вдруг кому-то станет интересно yes

Мне нужно присвоить значение первой найденной не пустой ячейки к переменной, чтобы уже её перенести в другую таблицу. Ячейки из столбца J на листе "Выгрузка" И каждую последующую найденную ячейку переносить в последующую строку на листе "Общая" как i=i+1 в определенный столбец D начиная со строки 15.
Я пытался сделать это через ПОИСКПОЗ, но видимо не могу додумать как это все правильно использовать(мучаюсь 4-ый день).


вот тут код к кнопке ActiveX

[vba]
Код
Option Explicit
Private Sub CommandButton1_Click()

Dim cName, i, cell, cDateCur
cDateCur = ("Жильцы") 'значение ячейки которое мы ищем.

Application.ScreenUpdating = False
i = 10
For Each cName In Array("Общая") 'Тут можно задать целый список/массив страниц на которых будет проводится поиск
For Each cell In Intersect(Sheets(cName).Columns("A"), Sheets(cName).UsedRange)
If cell.Value = cDateCur Then
cell.EntireRow.Copy
Cells(i, 1).PasteSpecial (xlValues) 'чтобы формулы не потекли, вставляем только значения найденных ячеек
i = i + 1
End If
Next
Next
cDateCur = ("Застройщики")
i = 30
For Each cName In Array("Общая")
For Each cell In Intersect(Sheets(cName).Columns("A"), Sheets(cName).UsedRange)
If cell.Value = cDateCur Then
cell.EntireRow.Copy
Cells(i, 1).PasteSpecial (xlValues)
i = i + 1
End If
Next
Next
Application.ScreenUpdating = True

End Sub
[/vba]

Автор - Vintik-ok
Дата добавления - 17.02.2014 в 11:04
KuklP Дата: Понедельник, 17.02.2014, 11:54 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
[vba]
Код
Public Sub www()
     On Error Resume Next
     Sheets("Выгрузка").[j:j].SpecialCells(2).Copy Sheets("Общая").[d15]
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[vba]
Код
Public Sub www()
     On Error Resume Next
     Sheets("Выгрузка").[j:j].SpecialCells(2).Copy Sheets("Общая").[d15]
End Sub
[/vba]

Автор - KuklP
Дата добавления - 17.02.2014 в 11:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск непустых ячеек. (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!