Страницы: 1
RSS
выбор строк и копирование по флажкам(checkbox) в указанный лист
 
Я как раз по данной теме!
Имеется табличка(прилагаю) в которой несколько листов, 1-й это командировка заполняется в командировке, остальные ведутся ежедневно(примерно).
При записи командировки-записываются ВСЕ данные и мои и чужие кто был со мной в командировке(как бы общий отчетный материал).

Возникает 2 вопроса: первый: - необходимо сделать кнопку (одну) и чекбоксы(напротив каждой строки), что бы при нажатии на кнопку копировались строки с флажками. При чем! копировались в указанный лист в следующую не заполненную строку (выпадающий список над кнопкой копировать)
 и второй: -как сделать чекбокс, который бы выделял все строки, в которых в примечании указан Я

П.С. примечание, столбцы синие и первая строка не копируются и определение следующей чистой строки по столбцу А (где дата)

П.П.С. объясню почему чекбоксы сделал-изначально задумка была-при нажатии кнопки копировать строки в которых дата -июнь-копируются в лист ИЮНЬ и т.п., но по моему такая реализация очень сложная, поэтому было решено сделать чекбоксы и указатель листа, в который копировать!
 
Вот сама таблица, для которой это все надо, сделал на её основе примерчик
Скрытый текст
П.С. размер файла 364 КБ, поэтому ссылку сделал
 
если вам нужно всегда копировать строчки с "Я" то чекбоксы не нужны или это обязательное условие.
 
необязательное, но вот копировать надо на листы согласно даты(столбец А), поэтому если на листе командировка в 2 месяца например с июня по июль, то дни относящиеся к июню должны быть в листе ИЮНЬ, а дни июля в лист ИЮЛЬ. поэтому и подумал что с помощью чекбоксов можно решить данную проблему:
отмечаешь дни июня флажками, указываешь лист ИЮНЬ и жмешь копировать и вуаЛЯ в листе июль добавились строки из командировки, отмеченные флажками! и .т.д.
 
С ЧекБоксами в строке не очень продуктивно: добавите строк - придётся добавлять и ЧекБоксы. Я бы использовал псевдо-ЧекБоксы. Как это сделать, можно почитать в разделе "Приемы" - вот статья
 
Спасибо, сделал псевдо чекбоксы, интересная тема, а как сделать что бы кнопка Копировать свои функции выполняла?
 
Покажите новый файл и поясните, что должно выполниться по кнопке. Результат для пары строк сделайте вручную.
 
сделал как Вы просили, так же файл ~300 КБ, поэтому ссылка на_пример
 
появился закономерный вопрос-при копировании, если не хватит свободных строк до итоговой таблицы(строки 41-55) внизу листа, что делать? макрос начнет записывать поверх итоговой таблицы? или есть вариант выдачи сообщения-"Копирование невозможно! Добавь строк в копируемый лист!"
Изменено: viktor595 - 26.10.2014 15:21:10
 
Откуда на листе ДЕКАБРЬ взялись даты в столбце А?
Зачем в примере рюшечки в виде формы? Зачем в ПРИМЕРЕ столько листов-месяцев? Хватило бы и двух - ноябрь и декабрь, например. Тогда и размер файла уменьшится...
 
Цитата
Юрий М пишет: Откуда на листе ДЕКАБРЬ взялись даты в столбце А?
Столбец А на листе ком-ка
Цитата
Зачем в примере рюшечки в виде формы?
не понял, где рюшечки?
Цитата
Зачем в ПРИМЕРЕ столько листов-месяцев?
это оригинальный файл, в принципе можно было и удалить.....
Удалил все кроме ком-ка, ноябрь и декабрь, все равно более 100 КБ
 
Цитата
viktor595 пишет: где рюшечки?
Рюшечка - в данном случае это форма, которая появляется при открытии книги. Она для решения задачи нужна?
Цитата
Удалил все кроме ком-ка, ноябрь и декабрь, все равно более 100 КБ
Есть архиваторы - тогда уместилось бы на форум. Кроме того, на всех листах полно пустых строк - их можно было удалить - размер файла также уменьшился бы. На листе ком-ка все строки ниже 56-ой тоже можно удалить - для решения задачи с кнопкой они абсолютно не нужны.
Виктор, пытаясь облегчить себе жизнь, старайтесь облегчить жизнь и тем, кто тратит своё время, чтобы помочь Вам.
Код на кнопку:
Код
Private Sub CommandButton1_Click()
Dim LastRow As Long, i As Long, SheetName As String, FreeRow As Long
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
    SheetName = Range("Z7")
    With Sheets(SheetName)
        FreeRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
        For i = 2 To LastRow
            If Cells(i, 23) = "a" Then
                .Range(.Cells(FreeRow, 2), .Cells(FreeRow, 22)).Value = Range(Cells(i, 2), Cells(i, 21)).Value
                FreeRow = FreeRow + 1
            End If
            If FreeRow = 40 Then
                MsgBox "Достигнут конец таблицы - последняя строка.", 64, "Внимание!!!"
                Exit For
            End If
        Next
    End With
End Sub 
 
Извиняюсь, что не правильно Вас понял, код работает, но не до конца....
Во первых, из за того что листы защищены в оригинальном файле, поэтому требуется копирование только столбцов 1,2,4,5,7-11, 14-21
Код
.Range(.Cells(FreeRow, 2), .Cells(FreeRow, 22)).Value = Range(Cells(i, 2), Cells(i, 21)).Value ' я так понимаю эта часть кода отвечает за столбцы которые копируются?
               ' можно указать как-то так:
.Range(.Cells(FreeRow, 1),.Cells(FreeRow, 2),.Cells(FreeRow, 4),.Cells(FreeRow, 5),.Cells(FreeRow, 7) ' и т.п., но чувствую что то не так, функция .Range определЯет границы ОТ и ДО....
и во-вторых, из за использования макроса по переводу 6-ти значного числа в столбце А в дату, а 4-х значного числа в столбцах J, K , N,O в время, при копировании данные получаются не в оригинальном виде, а ,например, время просто обнуляется (00:00), это возможно исправить?

П.С. файл сжал  ;)
 
Первый столбец я просто упустил. То, что нужно копировать не всю строку целиком, а отдельные ячейки - впервые слышу. Это легко можно исправить самостоятельно:
Код
.Cells(FreeRow, 1).Value = Cells(i, 1).Value
.Cells(FreeRow, 2).Value = Cells(i, 2).Value 
И т.д для нужных столбцов.
P.S. Подчистил Ваш первый файл - без сжатия 71К.
 
исправил, получилось вот так
Код
      .Cells(FreeRow, 1).Value = Cells(i, 1).Value
              .Cells(FreeRow, 2).Value = Cells(i, 2).Value
              .Cells(FreeRow, 4).Value = Cells(i, 4).Value
              .Cells(FreeRow, 5).Value = Cells(i, 5).Value
              .Range(.Cells(FreeRow, 7), .Cells(FreeRow, 11)).Value = Range(Cells(i, 7), Cells(i, 11)).Value
              .Range(.Cells(FreeRow, 14), .Cells(FreeRow, 21)).Value = Range(Cells(i, 14), Cells(i, 21)).Value 
 
Цитата
viktor595 пишет:
во-вторых, из за использования макроса по переводу 6-ти значного числа в столбце А в дату, а 4-х значного числа в столбцах J, K , N,O в время, при копировании данные получаются не в оригинальном виде, а ,например, время просто обнуляется (00:00), это возможно исправить?
а как быть с этим?
Страницы: 1
Наверх