Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование данных по дате и ФИО с листа на форму
 
#1
09.01.2020 17:17:57
Здравствуйте, помогите пожалуйста решить задачу, облазил форму но решения не нашел, в vba пока ещё туплю. Есть задача переноса данных из строк по критерию ФИО и даты, которые устанавливаются в другом листе. Файл с примером прикреплен. С уважением и заранее всем спасибо, Игорь  
 
 
 
#2
09.01.2020 17:24:38
under32, А можете установить дату и показать что должно в итоге получится? или дата и фио без повторений? т.е. один раз встречается?

вариант  в С14 и протянуть
Код
=ЕСЛИОШИБКА(ИНДЕКС(Лист1!C$2:C$5;ПОИСКПОЗ(1;ИНДЕКС((СЧЁТЕСЛИ(Лист2!$B$13:B13;Лист1!$C$2:$C$5)=0)/(Лист1!$F$2:$F$5=Лист2!$C$7);0);0));"")
Изменено: Mershik - 09.01.2020 17:32:14
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
09.01.2020 17:32:55
Здравствуйте, в прикрепленном файле указал, по сути должны копироваться все строки в определенном интервале и которые в содержат ФИО (лист1  столбец F), если не получается без дня недели в итоговой форме может содержаться и день недели это не критично. Спасибо Вам за ответ.
 
 
 
#4
09.01.2020 17:43:25
under32,
Код
=ЕСЛИОШИБКА(ИНДЕКС(Лист1!A$2:A$5;ПОИСКПОЗ(1;ИНДЕКС((СЧЁТЕСЛИ(Лист2!$B$13:B13;Лист1!$C$2:$C$5)=0)/((Лист1!$F$2:$F$5=Лист2!$C$7)*($F$4<=Лист1!$C$2:$C$5)*(Лист1!$C$2:$C$5<=Лист2!$H$4));0);0));"")
Изменено: Mershik - 09.01.2020 17:44:23
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
09.01.2020 17:50:57
Спасибо, за подсказку, я данную формулу находил но проблема в том, что там данные будут заполнятся в итоге будет по 50 тыс. строк и она очень долго работает. Я бы видимо, больше хотел найти решения на базе VBA, я нашел пример на сайте по переносу на другой лист по дате, но не могу допереть какк поставить ещё один критерии.
Код
Sub SERZH() 'http://www.planetaexcel.ru/forum.php?thread_id=31559
Dim iLastRow As Long, jLastRow As Long, i As Long, DateStart As Date, DateFinish As Date
DateStart = [E1]
DateFinish = [G1]
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    With Sheets("Ëèñò2")
        jLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
'        .Range(.Cells(8, 1), .Cells(jLastRow + 2, 14)).ClearContents
'Íåìíîãî èñïðàâèì ýòó ñòðîêó: áóäåì î÷èùàòü ÂѨ (è ôîðìàòû)
        .Range(.Cells(8, 1), .Cells(jLastRow + 2, 14)).Clear
        jLastRow = 7
        For i = 8 To iLastRow
            If Cells(i, 4) >= DateStart Then
                If Cells(i, 4) <= DateFinish Then
'                    Range(Cells(i, 1), Cells(i, 14)).Copy .Cells(jLastRow + 1, 1) 'Ñêîëüêî ïåðåíîñòñÿ ñòîëáöîâ
'                    .Cells(jLastRow + 1, 14).Value = Cells(i, 14).Value
                    .Range(.Cells(jLastRow + 1, 1), .Cells(jLastRow + 1, 14)).Value = Range(Cells(i, 1), Cells(i, 14)).Value
                    jLastRow = jLastRow + 1
                End If
            End If
        Next
        .Cells(jLastRow + 1, 1) = "ÐÀÇÎÌ:"
        .Cells(jLastRow + 1, 8) = Application.WorksheetFunction.Sum(Range(.Cells(8, 8), .Cells(jLastRow + 1, 8)))
        .Cells(jLastRow + 1, 9) = Application.WorksheetFunction.Sum(Range(.Cells(8, 9), .Cells(jLastRow + 1, 9)))
        .Cells(jLastRow + 1, 10) = Application.WorksheetFunction.Sum(Range(.Cells(8, 10), .Cells(jLastRow + 1, 10)))
        .Cells(jLastRow + 1, 12) = Application.WorksheetFunction.Sum(Range(.Cells(8, 12), .Cells(jLastRow + 1, 12)))
        .Cells(jLastRow + 1, 14) = Application.WorksheetFunction.Sum(Range(.Cells(8, 14), .Cells(jLastRow + 1, 14)))
        .Range(.Cells(8, 1), .Cells(jLastRow + 1, 14)).Borders.LineStyle = xlContinuous 'Ðèñóåì ãðàíèöû
        .Range(.Cells(jLastRow + 1, 1), .Cells(jLastRow + 1, 14)).Font.Bold = True 'Äåëàåì â ïîñëåäíåé ñòðîêå æèðíûé øðèôò
    End With
End Sub
 
 
 
#6
09.01.2020 17:58:25
Mershik, да макрос будет лучше ну может кто поможет.
завтра могу попробовать помочь)
а еще при копирования макроса который вы приложили выше - перед его копированием установить русский язык и потом копируйте (что бы небыло иероглифов зеленым текстом)
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
10.01.2020 08:35:24
Сделал как понял  :D
Для двух файлов
Изменено: Nordheim - 10.01.2020 08:46:31
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#8
18.01.2020 15:49:28
Спасибо, все работает  
 
 
 
Страницы: 1
Наверх