Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование ячеек по листам с условием, Написание кода VBA
 
#1
11.07.2013 13:12:53
Здравствуйте! Уважаемые формучане. Помогите с моей проблемой. Введется учет по проживанию в Excel. Гуглю уже 2 дня и почти ничего по своей проблеме найти не могу, а что нахожу мне не подходит. На данный момент нашел код написанный на VBA, который по определенным условиям разбрасывает данные по листам в книге. Он работает но не совсем правильно, как хотелось бы.
Сейчас у меня есть шахматка по местам в комнатах на листе под названием "Общий".  У меня для каждой комнаты выделено определенное количество строк с данными, которые мне нужны. Где указывается с какой организации сотрудник. В конце месяца я сдаю отчётность по организациям кто и сколько дней проживал у нас. Сейчас я это делаю в конце месяца выставляю фильтр по организациям и раскидываю по листам. Организаций может порой быть такое количество что просто такой трудоемкий труд бывает. Помогите упростить работу мне немного. На данный момент я добавил кнопку и вставил макрос найденный в интернете. Объясню как работает сейчас.

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

Как бы хотелось
Хотелось бы, что бы когда нажимаешь на кнопку раскинуть по листам. То тогда была какая то проверка по Ф.И.О. человека, если данный человек есть в списке на листе куда копируются данные то тогда, если были изменения добавить эти изменения в уже существующий строку, а если не находит то добавляет новый.

Я сам в VBA не селён. Помогите с данной проблемой. Файл пример прикладываю.
 
 
 
#2
11.07.2013 13:46:19
Тогда перед копированием строки нужно сперва в том листе поискать такое сочетание фамилия-дата, и если есть - то копировать именно в ту строку. Ну а если нет - то ниже.
Если данных не тысячи строк - то в общем можно пройтись простым перебором с первой строки до wsSh.Cells(wsSh.Rows.Count, 1).End(xlUp).row
 
 
 
#3
11.07.2013 13:49:50
Спасибо Вам большое. Подскажите а куда добавить данную строку в коде, что бы это заработало
-------------------------------------------------------------------------------------------------------------------
Dim li As Long, lLastRow As Long, wsSh As Worksheet

With Sheets("Общий")
lLastRow = .Cells(Rows.Count, 3).End(xlUp).Row 'находим последнюю строку
   On Error Resume Next
   For li = 3 To lLastRow 'перебираем весь столбец по условию до последней строки
   Set wsSh = Sheets(Trim(.Cells(li, 7).Value))
       If Not wsSh Is Nothing Then
           wsSh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4).Value = .Cells(li, 3).Resize(, 4).Value
       End If
       Set wsSh = Nothing
   Next li
End With
-------------------------------------------------------------------------------------------------------------------
 
 
 
#4
11.07.2013 14:02:14
Вроде так:

Код
Sub Вагон1()
    Dim li As Long, lLastRow As Long, wsSh As Worksheet
    Dim lr&, i&, flag As Boolean, t$
    With Sheets("Общий")
        lLastRow = .Cells(Rows.Count, 3).End(xlUp).Row    'находим последнюю строку
        On Error Resume Next
        For li = 3 To lLastRow    'перебираем весь столбец по условию до последней строки
            Set wsSh = Sheets(Trim(.Cells(li, 7).Value))
            If Not wsSh Is Nothing Then
                lr = wsSh.Cells(wsSh.Rows.Count, 1).End(xlUp).Row
                flag = False
                t = .Cells(li, 3).Value & "|" & .Cells(li, 5).Value
                For i = 1 To lr
                    If wsSh.Cells(i, 1) & "|" & wsSh.Cells(i, 3) = t Then
                        wsSh.Cells(i, 1).Resize(, 4).Value = .Cells(li, 3).Resize(, 4).Value
                        flag = True
                        Exit For
                    End If
                Next
                If Not flag Then wsSh.Cells(wsSh.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4).Value = .Cells(li, 3).Resize(, 4).Value
            End If
            Set wsSh = Nothing
        Next li
    End With
End Sub
 
 
 
#5
11.07.2013 14:04:38
О боже вы всемогущий. Благодарю Вас. Дайте свой номер телефона я вам хоть баланс брошу. ;)  Какая ни какая все таки благодарность за столь чудесный код
 
 
 
#6
11.07.2013 14:10:24
Так код ведь не мой :)
Я лишь мелочь дописал.
Если данных много, и перебор заметно тормозит процесс - тогда нужно усложнять на find/findnext, или брать данные в массви и перебирать массив. Я бы вероятно перебирал массив - код проще.

А телефона у меня такого нет, на который можно денег кинуть :)
Да и работы-то тут было на 5 копеек...
 
 
 
#7
11.07.2013 14:27:29
Ясно! Спасибо Вам. Я вам очень благодарен!  :) Очень очень упростили мне труд. Если можно у Вас еще спросить кое что. А пока пользуясь случаем, хочется спросить. Можно ли будет как то сделать еще такие кнопки, что бы автоматически проставлялись в пустых ячейках даты убытия, дата последнего дня текущего месяца НАПРИМЕР (31.07.2013). Что бы не самому это делать, а само все где пусто ставилась такая дата. И кнопку автоматического очищения листа где установлена дата не последняя дата текущего месяца?

Просто в конце месяца сдача отчета. Мне нужно сдавать отчет о прожитих дней человека и ели он живет еще дальше в этом месяце, то мне приходится поставить в "дату убытия" последнюю дату месяца рассчитывается количество дней, сдается отчет и после уже очищается список у кого не стоит дата на 31.07.2013 г. Т.е. переносится люди на следующий месяц, где по новой ведется с первого числа количество прожитых дней человека. Просто хотелось бы как то быстро это делать не замудряясь копированием и вставкой. Возможно такое?
 
 
 
#8
11.07.2013 14:38:17
Да можно что угодно делать...
Я думаю может быть такой вариант:
цикл по общему листу от 3 до конца данных в "C", проверяем наличие даты в "E" и отсутсвие в "F" - если так, то в "F" ставим последнее число месяца (или сегодняншнее число, или запросить в начале кода), а куда нибудь в "M" метку.
После цикла выполняем Sub Вагон1(), затем цикл по "M" также от 3 до до конца данных в "C", в строке с метками удаляем дату в "F" и саму метку.
Думаю неспеша можете сами такой код написать - все "кирпичики" в общем уже в Вашем коде есть.
Это будет отдельный код на отдельную спецкнопку.
 
 
 
#9
11.07.2013 14:43:31
Хорошо. Понял. Постараюсь сделать. думаю разберусь :)
 
 
 
#10
12.12.2018 17:49:19
Добрый день.
Необходимо раскинуть данные с листа "TDSheet" по листам согласно даты загрузки по столбцу L. Если в столбце L дата 06.12.2018, то создать лист с таким названием и перенести все строки заявки включая и оранжевую с итого. Спасибо.
 
 
 
Страницы: 1
Читают тему
Наверх