Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание дополнительной строчки в выбранном месте и точной копии
 
#1
07.06.2016 17:56:07
Здравствуйте.
Нужно забивать информацию и много. Думал сделать все на макросах, но оказалось все сложнее, чем выглядело. Решил просто создать таблицу и вручную забивать. Но столкнулся с проблемой. Когда создаю дополнительную строчку. При ее создании, нужно опять объединять столбцы и удалять время которое я прописал макросом после исправления. Это занимает очень много времени. Помогите создать макрос, который при нажатии на кнопку будет создавать строчку в выбранной области в точности такую же.
В примере. Я создаю строчку и она создается как вариант B, нужно что бы она создавалась как вариант А или С. Где вариант С после забивания информации в объединенный столбик С и D появлялась дата и время. Либо при нажатии "кнопка 5" создавалась строчка с датой и временем.

Находил темы, где создают макросы под кнопку, но так как совсем нету опыта, убив уже два дня я так и не смог вникнуть в код, так что бы сделать то что хочу.
Пожалуйста, помогите с макросом. Файл загрузил
 Работаю в Microsoft Office Excel 2007
 
 
 
#2
07.06.2016 19:12:24
Макрорекордером не пробовали...? :) Раз-два действие(я) выполняете, смотрите что получилось, переписываете... ;)
Успехов. И мне того же. Благодарю. :)
 
 
 
#3
08.06.2016 11:48:46
Я пробовал им, ни чего не выходила. Сейчас углубился больше, создал:
Код
 Rows("6:6").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Range("C6:D6").Select
     Selection.Merge
     Selection.ClearContents
     Range("B6").Select
     Selection.ClearContents
     Range("E6").Select
     Selection.ClearContents

Но это только в этом промежутке. А надо что бы создавалось после выбранной строчки. Не говорю уже о том как он это делает. Все видно. А инструментов не нашел, в гугле и яндексе находил только общее обращение с ним, и конкретики я не увидел =(

Может можно все еще проще сделать и в этот код:
Код
 For Each cell In Target
        If Not Intersect(cell, Range("C2:C1000")) Is Nothing Then
             With cell.Offset(0, 1)
                .Value = Time
                            End With
        End If
            Next cell
            For Each cell In Target
        If Not Intersect(cell, Range("C2:C1000")) Is Nothing Then
             With cell.Offset(0, -1)
                .Value = Date
                            End With
        End If
        Next cell

Запихнуть еще и добавление строчки? Что бы при введении информации появлялось не только время и дата, но и сразу добавлялась следующая строчка. Такое возможно?
 А то пытался впихнуть сюда код от записи и ковырял его. До ковырялся, что программа просто повисла =)
 
 
 
#4
08.06.2016 16:59:42
Все еще ковыряюсь.. Нашел код в интернете:
Код
Option Explicit

Public Sub InsertBlankRow()
On Error GoTo QuietError
    Dim clsTarget As Excel.Range
    
    'Если эта строка вызовет ошибку, значит выбрана
    'не ячейка на рабочем листе, а что-то другое.
    Set clsTarget = Selection
        
    'Вставляю строку.
    clsTarget.EntireRow.Insert xlDown
Exit Sub
QuietError:
    'Выведу "тихое" сообщение об ошибке на Панели состояния.
    Application.StatusBar = Err.Description
    'Поторможу 2 секунды, чтоб пользователь обратил внимание на ошибку.
    Application.Wait Now + TimeSerial(0, 0, 2)
    'Отдам Excell'ю панель состояния.
    Application.StatusBar = False
End Sub
Работает он почти как нужно, но в моем примере,
где ставиться дата и время он не объединяет ячейки, а так же сразу создает
время из за уже имеющегося кода в исходном тексте. Как сделать что бы объединял
ячейки С и D? И можно ли его объединить с этим кодом в исходном тексте, что бы
при введении информации добавлялась строчка пустая с объединеными ячейками C и D без времени и даты (хотя если
там будет дата это будет не страшно, просто пустая история). Что бы без всяких
клавиш клик: *?
Код
For Each cell In Target        If Not Intersect(cell, Range("C2:C1000")) Is Nothing Then
             With cell.Offset(0, 1)
                .Value = Time
                            End With
        End If
            Next cell
            For Each cell In Target
        If Not Intersect(cell, Range("C2:C1000")) Is Nothing Then
             With cell.Offset(0, -1)
                .Value = Date
                            End With
        End If
        Next cell
Если добавить в 1 код:
Код
'Вставляю строку.
    clsTarget.EntireRow.Insert xlDown
    Selection.Merge
    Selection.ClearContents
То ячейки объединяются, а время переносится куда нужно. Но это происходит не моментально...
Ну а без клавиши совсем не получается ни чего =(

Упростил код:
Код
Public Sub InsertBlankRow()
    Dim clsTarget As Excel.Range
    Set clsTarget = Selection
    clsTarget.EntireRow.Insert xlDown
    Selection.Merge
    Selection.ClearContents
End Sub
Но все еще делает со временем создание.
Изменено: mefxl - 08.06.2016 17:29:48
 
 
 
#5
08.06.2016 17:44:10
1. Не понятно почему Вы разместили код в "Worksheet_Change" - это должно происходить по изменению листа? Зачем? Может лучше вывести в модуль и "повесить на кнопку"? В таком случае нужно будет в коде определить:
Код
    Dim Target As Range
    Set Target = Selection ' выделенная ячейка
2. То, что записалось макрорекордером можно легко поправить: читаете справку (например) по команде (например, Range), подключаете мозг... Вот пример:
Код
     Rows(cell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' вставка строки со сдвигом вниз и копированием формата сверху
    cell.Offset(???, ???).Merge ' объединение ячеек, с оффсетами тут сами разберётесь, надеюсь... можете ещё подключить Resize - изменение размера диапазона так:
'    cell.Offset(???, ???).Resize(???, ???).Merge ' объединение ячеек, с оффсетами и ресайзами тут сами разберётесь, надеюсь...
'    ???.ClearContents ' - очистка содержимого ячейки/ячеек (можете справку почитать), не понял для чего очищать вставленную строку (она ведь пустая??)...
3. Не понял для чего Вы дважды проходите ячейки циклом, когда это всё можно объединить в один проход:
Код
    For Each cell In Target   'проходим по всем измененным ячейкам
        If Not Intersect(cell, Range("C2:C1000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(0, 1)         'вводим в соседнюю справа ячейку дату
                .Value = Time
            End With
            With cell.Offset(0, -1)         'вводим в соседнюю СЛЕВА ячейку дату
                .Value = Time
            End With
        End If
    Next cell
4. Почитайте про Offset... особенно обратите внимание на отрицательные значения сдвигов (выделил прописными буквами исправленную ошибку в комментарии к коду).
Успехов. И мне того же. Благодарю. :)
 
 
 
#6
08.06.2016 17:58:16
Да я хотел что бы сразу забивалась дата и время. Что бы не нажимать постоянно Ctrl+Ж и Ctrl+Shift+Ж.
Справку почитаю еще раз, но видимо я туповат, или осознавая что мне это все не нужно в будущем, пытаюсь быстрее решить свою проблему.. (хотя потратил уже кучу времени)
Цикл дважды идет по простой причине. Я не разбираюсь в коде совсем и просто методом тыка сделал так как Вы видите.
Про Offset почитаем спасибо.
Надеюсь разберусь или буду использовать как допер сам =)
 
 
 
#7
08.06.2016 20:16:54
Ещё у Вас есть вариант обратиться сюда. Там за определённую плату (и часто в довольно быстрые сроки) Вам сделают то, что хотите. ;)
Изменено: Ренат - 08.06.2016 20:17:14
Успехов. И мне того же. Благодарю. :)
 
 
 
#8
09.06.2016 08:51:05
Да думал платно сделать, наверняка такая фигня стоит копейки. Но на почту мне так и не ответили и поэтому забил, а на форуме решил сюда написать сначала.
Но все равно спасибо за помощь.
 
 
 
Страницы: 1
Наверх