Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выбор активной ячейки в базе (работа с строкой) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор активной ячейки в базе (работа с строкой) (Макросы/Sub)
Выбор активной ячейки в базе (работа с строкой)
Boonar Дата: Вторник, 01.11.2016, 09:16 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Добрый день, уважаемые форумчане!
В работе пользуемся базой, и там есть такой макрос, для того, что бы "ткнуть в нужную ячейку, а в верхней строке окажутся данные со всей строки, которые пойдут в дальнейшие формы":

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
stroka = ActiveCell.Row
With Sheets("База")
.Cells(2, 1).Value = .Cells(stroka, 1).Value
.Cells(2, 2).Value = .Cells(stroka, 2).Value
.Cells(2, 3).Value = .Cells(stroka, 3).Value
.Cells(2, 4).Value = .Cells(stroka, 4).Value
.Cells(2, 5).Value = .Cells(stroka, 5).Value
.Cells(2, 6).Value = .Cells(stroka, 6).Value
.Cells(2, 7).Value = .Cells(stroka, 7).Value
.Cells(2, 8).Value = .Cells(stroka, 8).Value
.Cells(2, 9).Value = .Cells(stroka, 9).Value
.Cells(2, 10).Value = .Cells(stroka, 10).Value
.Cells(2, 11).Value = .Cells(stroka, 11).Value
.Cells(2, 12).Value = .Cells(stroka, 12).Value
.Cells(2, 13).Value = .Cells(stroka, 13).Value
.Cells(2, 14).Value = .Cells(stroka, 14).Value
.Cells(2, 15).Value = .Cells(stroka, 15).Value
.Cells(2, 16).Value = .Cells(stroka, 16).Value
.Cells(2, 17).Value = .Cells(stroka, 17).Value
.Cells(2, 18).Value = .Cells(stroka, 18).Value
.Cells(2, 19).Value = .Cells(stroka, 19).Value
.Cells(2, 20).Value = .Cells(stroka, 20).Value
.Cells(2, 21).Value = .Cells(stroka, 21).Value
.Cells(2, 22).Value = .Cells(stroka, 22).Value
.Cells(2, 23).Value = .Cells(stroka, 23).Value
.Cells(2, 24).Value = .Cells(stroka, 24).Value
.Cells(2, 25).Value = .Cells(stroka, 25).Value
.Cells(2, 26).Value = .Cells(stroka, 26).Value
.Cells(2, 27).Value = .Cells(stroka, 27).Value
.Cells(2, 28).Value = .Cells(stroka, 28).Value
.Cells(2, 29).Value = .Cells(stroka, 29).Value
.Cells(2, 30).Value = .Cells(stroka, 30).Value
.Cells(2, 31).Value = .Cells(stroka, 31).Value
.Cells(2, 32).Value = .Cells(stroka, 32).Value
.Cells(2, 33).Value = .Cells(stroka, 33).Value
.Cells(2, 34).Value = .Cells(stroka, 34).Value
End With
End Sub
[/vba]

Собственно вопрос: чем можно заменить этот макрос? В таблице под 500 строк и опрашивая их, файл зависает.

Опыт приходит с возрастом. Но иногда, возраст приходит один...

Сообщение отредактировал Boonar - Вторник, 01.11.2016, 09:58
 
Ответить
СообщениеДобрый день, уважаемые форумчане!
В работе пользуемся базой, и там есть такой макрос, для того, что бы "ткнуть в нужную ячейку, а в верхней строке окажутся данные со всей строки, которые пойдут в дальнейшие формы":

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
stroka = ActiveCell.Row
With Sheets("База")
.Cells(2, 1).Value = .Cells(stroka, 1).Value
.Cells(2, 2).Value = .Cells(stroka, 2).Value
.Cells(2, 3).Value = .Cells(stroka, 3).Value
.Cells(2, 4).Value = .Cells(stroka, 4).Value
.Cells(2, 5).Value = .Cells(stroka, 5).Value
.Cells(2, 6).Value = .Cells(stroka, 6).Value
.Cells(2, 7).Value = .Cells(stroka, 7).Value
.Cells(2, 8).Value = .Cells(stroka, 8).Value
.Cells(2, 9).Value = .Cells(stroka, 9).Value
.Cells(2, 10).Value = .Cells(stroka, 10).Value
.Cells(2, 11).Value = .Cells(stroka, 11).Value
.Cells(2, 12).Value = .Cells(stroka, 12).Value
.Cells(2, 13).Value = .Cells(stroka, 13).Value
.Cells(2, 14).Value = .Cells(stroka, 14).Value
.Cells(2, 15).Value = .Cells(stroka, 15).Value
.Cells(2, 16).Value = .Cells(stroka, 16).Value
.Cells(2, 17).Value = .Cells(stroka, 17).Value
.Cells(2, 18).Value = .Cells(stroka, 18).Value
.Cells(2, 19).Value = .Cells(stroka, 19).Value
.Cells(2, 20).Value = .Cells(stroka, 20).Value
.Cells(2, 21).Value = .Cells(stroka, 21).Value
.Cells(2, 22).Value = .Cells(stroka, 22).Value
.Cells(2, 23).Value = .Cells(stroka, 23).Value
.Cells(2, 24).Value = .Cells(stroka, 24).Value
.Cells(2, 25).Value = .Cells(stroka, 25).Value
.Cells(2, 26).Value = .Cells(stroka, 26).Value
.Cells(2, 27).Value = .Cells(stroka, 27).Value
.Cells(2, 28).Value = .Cells(stroka, 28).Value
.Cells(2, 29).Value = .Cells(stroka, 29).Value
.Cells(2, 30).Value = .Cells(stroka, 30).Value
.Cells(2, 31).Value = .Cells(stroka, 31).Value
.Cells(2, 32).Value = .Cells(stroka, 32).Value
.Cells(2, 33).Value = .Cells(stroka, 33).Value
.Cells(2, 34).Value = .Cells(stroka, 34).Value
End With
End Sub
[/vba]

Собственно вопрос: чем можно заменить этот макрос? В таблице под 500 строк и опрашивая их, файл зависает.
Автор - Boonar
Дата добавления - 01.11.2016 в 09:16
Manyasha Дата: Вторник, 01.11.2016, 09:25 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Boonar, попробуйте так:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        .Cells(2, 1).Resize(, lr) = .Cells(stroka, 1).Resize(, lr)
    End With
End Sub
[/vba]
[p.s.]Кнопка fx - для оформления формул, для кода используйте #. Поправьте свой пост.[/p.s.]

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеBoonar, попробуйте так:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        .Cells(2, 1).Resize(, lr) = .Cells(stroka, 1).Resize(, lr)
    End With
End Sub
[/vba]
[p.s.]Кнопка fx - для оформления формул, для кода используйте #. Поправьте свой пост.[/p.s.]
Автор - Manyasha
Дата добавления - 01.11.2016 в 09:25
Boonar Дата: Вторник, 01.11.2016, 09:48 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Спасибо Марина! Пока не разобрался в форуме, извините за плохое оформление. Просто скопировал как есть.

Опыт приходит с возрастом. Но иногда, возраст приходит один...
 
Ответить
СообщениеСпасибо Марина! Пока не разобрался в форуме, извините за плохое оформление. Просто скопировал как есть.
Автор - Boonar
Дата добавления - 01.11.2016 в 09:48
Manyasha Дата: Вторник, 01.11.2016, 09:49 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Boonar, 2 раза правила Вам пост, а Вы обратно все возвращаете :D
Старые теги нужно удалить, выделить весь код в посте (который хотите оформить) и нажать на кнопку #.
Должно получиться так [vbа][сode]код макроса[/сode][/vbа]

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеBoonar, 2 раза правила Вам пост, а Вы обратно все возвращаете :D
Старые теги нужно удалить, выделить весь код в посте (который хотите оформить) и нажать на кнопку #.
Должно получиться так [vbа][сode]код макроса[/сode][/vbа]
Автор - Manyasha
Дата добавления - 01.11.2016 в 09:49
Boonar Дата: Вторник, 01.11.2016, 09:56 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
:D Тяни-толкай получался) Спасибо за консультацию-сделал.
По Вашему коду-не взлетел.
Тот, который был-все прописывал во второй строке. Ваш-чего-то замолчал. :(

Опыт приходит с возрастом. Но иногда, возраст приходит один...
 
Ответить
Сообщение:D Тяни-толкай получался) Спасибо за консультацию-сделал.
По Вашему коду-не взлетел.
Тот, который был-все прописывал во второй строке. Ваш-чего-то замолчал. :(
Автор - Boonar
Дата добавления - 01.11.2016 в 09:56
Manyasha Дата: Вторник, 01.11.2016, 10:10 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Boonar, а так?
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(2, 1).Resize(, lr).Value = .Cells(stroka, 1).Resize(, lr).Value
    End With
    Application.EnableEvents = True
End Sub
[/vba]
или вот еще вариант (в файле см. лист База2)
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База2")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(stroka, 1).Resize(, lr).Copy
        .Cells(2, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
    Application.EnableEvents = True
End Sub
[/vba]
К сообщению приложен файл: primer.xlsm (17.7 Kb)

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеBoonar, а так?
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(2, 1).Resize(, lr).Value = .Cells(stroka, 1).Resize(, lr).Value
    End With
    Application.EnableEvents = True
End Sub
[/vba]
или вот еще вариант (в файле см. лист База2)
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База2")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(stroka, 1).Resize(, lr).Copy
        .Cells(2, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
    Application.EnableEvents = True
End Sub
[/vba]
Автор - Manyasha
Дата добавления - 01.11.2016 в 10:10
Boonar Дата: Вторник, 01.11.2016, 10:15 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Марина. Второй вариант-работает именно так как надо. Третий-нет.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(2, 1).Resize(, lr).Value = .Cells(stroka, 1).Resize(, lr).Value
    End With
    Application.EnableEvents = True
End Sub
[/vba]
даже на слабой машине не висит. Спасибо! Вы-МОЗГ! :)

Опыт приходит с возрастом. Но иногда, возраст приходит один...
 
Ответить
СообщениеМарина. Второй вариант-работает именно так как надо. Третий-нет.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    stroka = ActiveCell.Row
    With Sheets("База")
        'номер последнего столбца
        lr = .Cells(stroka, Columns.Count).End(xlToLeft).Column
        'очищение строки 2
        .Rows(2).ClearContents
        .Cells(2, 1).Resize(, lr).Value = .Cells(stroka, 1).Resize(, lr).Value
    End With
    Application.EnableEvents = True
End Sub
[/vba]
даже на слабой машине не висит. Спасибо! Вы-МОЗГ! :)
Автор - Boonar
Дата добавления - 01.11.2016 в 10:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор активной ячейки в базе (работа с строкой) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!