Страницы: 1
RSS
Поиск сегодняшней даты (VBA) (подскажите пожалуйста).
 
Уважаемые, прошу помочь написать макрос.    
Необходимо просмотреть определенный диапазон (столбец А вниз начиная допустим с 10-ой строки) ячеек на листе, содержащих даты на предмет наличия ячейки, содержащей сегодняшнюю дату. (Диапазон каждый день увеличивается).  
Если сегодняшняя дата присутствует в этом диапазоне ячеек - ничего делать не надо.  
Если сегодняшней даты нет - скопировать в последнюю строку (ниже строки, содержащей последнее значение) определенный диапазон строк (ну скажем с 5-ую по 8-ую строку).  
 
PS Извините за чайниковские вопросы. Работаю с Excel довольно давно, но с VBA -  практически не приходилось сталкиваться - максимум записывал макросы рекордером и потом корректировал. :( Подскажите пожалуйста что лучше почитать, чтобы максимально быстро освоить основы VBA и перестать Вас мучить. :)
 
Palex, у Вас уже 61 сообщение :-) Правила не удосужились прочитать (по поводу файла-примера)?  По поводу литературы - в "Копилку".
 
Юрий М, не потому я пример не разместил, что правил не читал или лень, а оттого, что посчитал, что словами понятно вполне описал то, что получить хотелось бы..    
А пример (хоть и не несет он, дополнительной смысловой нагрузки), размещаю для наглядности все же.. :)  
Спасибо. :)
 
Пример, он не для наглядности, Palex. А чтоб было над чем работать. Рисовать за Вас таблицы всем лень.
Я сам - дурнее всякого примера! ...
 
Palex, да Вы поймите - никто не хочет рисовать эти таблицы с данными. А потом ещё окажется, что данные не в том столбце, даты не там...
 
Согласен. Приношу свои извинения. :(
 
Public Sub www()  
   Dim lr As Long, i As Long  
   lr = Cells(Rows.Count, 1).End(xlUp).Row  
   For i = 10 To lr  
       If CDate(Cells(i, 1)) = Date Then Exit Sub  
   Next  
   Range("A5:B8").Copy Cells(lr + 1, 1)  
End Sub
Я сам - дурнее всякого примера! ...
 
Или без цикла:  
Sub wqw()  
Dim iLastRow As Long  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
   If Application.WorksheetFunction.CountIf(Range(Cells(10, 1), Cells(iLastRow, 1)), Date) Then  
       Range(Cells(5, 1), Cells(8, 2)).Copy Cells(iLastRow + 1, 1)  
   End If  
End Sub
 
Про нолик забыл :-)  
Sub wqw()  
Dim iLastRow As Long  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
   If Application.WorksheetFunction.CountIf(Range(Cells(10, 1), Cells(iLastRow, 1)), Date) = 0 Then  
       Range(Cells(5, 1), Cells(8, 2)).Copy Cells(iLastRow + 1, 1)  
   End If  
End Sub
 
Спасибо Вам огромное, ребят! Все работает!  
*ушел читать книжки по VBA*  
:)
Страницы: 1
Читают тему
Наверх