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

Вход

Регистрация

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

 

= Мир MS Excel/копирования и вставка данных из последних заполненных ячеек - Мир MS Excel

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

Excel 2010
Все добрый день!
Требуются помощь знающих людей - сам точно не осилю
Работаю с таблицей, в которой для сравнения результатов расчетов, нужно копировать значения из последних заполненных ячеек таблицы и вставлять на одну строчку ниже. Потом делается расчет с новыми данными в этой же таблице, и сравниваются полученные результаты.
И вот если бы количество строк в таблице было неизменным, то было бы все просто. Но к сожалению оно каждый раз разное.
Макрос с копированием и вставкой данных из конкретных ячеек я с грехом пополам сделал при помощи рикордера. А вот как в VBA написать чтобы копирование было из последней ячейки, содержащей данные, и вставка значения на строку ниже, я попросту не знаю.
Вот такой у меня макрос получился. Ну пример с таблицей тоже прилагаю с тем же макросом
[vba]
Код

Sub Сравнение()
Range("B11:D11").Select
    Selection.Copy
      Range("B13").Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B13,C13,D13").Select
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End Sub

[/vba]
К сообщению приложен файл: 8087279.xlsm (18.8 Kb)


Сообщение отредактировал Serge1400 - Среда, 30.05.2018, 16:18
 
Ответить
СообщениеВсе добрый день!
Требуются помощь знающих людей - сам точно не осилю
Работаю с таблицей, в которой для сравнения результатов расчетов, нужно копировать значения из последних заполненных ячеек таблицы и вставлять на одну строчку ниже. Потом делается расчет с новыми данными в этой же таблице, и сравниваются полученные результаты.
И вот если бы количество строк в таблице было неизменным, то было бы все просто. Но к сожалению оно каждый раз разное.
Макрос с копированием и вставкой данных из конкретных ячеек я с грехом пополам сделал при помощи рикордера. А вот как в VBA написать чтобы копирование было из последней ячейки, содержащей данные, и вставка значения на строку ниже, я попросту не знаю.
Вот такой у меня макрос получился. Ну пример с таблицей тоже прилагаю с тем же макросом
[vba]
Код

Sub Сравнение()
Range("B11:D11").Select
    Selection.Copy
      Range("B13").Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B13,C13,D13").Select
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End Sub

[/vba]

Автор - Serge1400
Дата добавления - 30.05.2018 в 16:14
sboy Дата: Среда, 30.05.2018, 16:34 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Вот такой вариант
[vba]
Код
Sub Сравнение()
    Set r1 = Cells(Rows.Count, 2).End(xlUp)
    Set r2 = Cells(1, 2).End(xlDown)
        With r1.Offset(IIf(r1.Row = r2.Row, 2, 1), 0).Resize(1, 3)
            .Value = r2.Resize(1, 3).Value
            With .Borders
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
    End With
End Sub
[/vba]
К сообщению приложен файл: 4907933.xlsm (16.3 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Вот такой вариант
[vba]
Код
Sub Сравнение()
    Set r1 = Cells(Rows.Count, 2).End(xlUp)
    Set r2 = Cells(1, 2).End(xlDown)
        With r1.Offset(IIf(r1.Row = r2.Row, 2, 1), 0).Resize(1, 3)
            .Value = r2.Resize(1, 3).Value
            With .Borders
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
    End With
End Sub
[/vba]

Автор - sboy
Дата добавления - 30.05.2018 в 16:34
_Boroda_ Дата: Среда, 30.05.2018, 16:56 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16672
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Еще вариант
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    With Range("B" & Range("B" & Rows.Count).End(3).Row).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 8087279_1.xlsm (16.5 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЕще вариант
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    With Range("B" & Range("B" & Rows.Count).End(3).Row).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 30.05.2018 в 16:56
sboy Дата: Среда, 30.05.2018, 17:11 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Еще вариант

А я подумал, что сравнений может быть несколько и они друг за другом записываться должны...
Если все-таки по-одному сравнивать, то тогда и предыдущее удалять бы надо.


Яндекс: 410016850021169
 
Ответить
Сообщение
Еще вариант

А я подумал, что сравнений может быть несколько и они друг за другом записываться должны...
Если все-таки по-одному сравнивать, то тогда и предыдущее удалять бы надо.

Автор - sboy
Дата добавления - 30.05.2018 в 17:11
_Boroda_ Дата: Среда, 30.05.2018, 17:22 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16672
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Тогда так (если по одному)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    With Range("B" & Range("A" & Rows.Count).End(3).Row).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

А если несколько, то у меня так и делает в первом посте
К сообщению приложен файл: 8087279_2.xlsm (16.5 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТогда так (если по одному)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    With Range("B" & Range("A" & Rows.Count).End(3).Row).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

А если несколько, то у меня так и делает в первом посте

Автор - _Boroda_
Дата добавления - 30.05.2018 в 17:22
Serge1400 Дата: Среда, 30.05.2018, 17:50 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо за оба варианта! Сидел разбирался как переназначить копирование - разобрался!
Оба работают как надо. Только второй ( от Бороды) всасывает и вставляет еще и цвет заливки . Сейчас думаю какой лучше использовать.
Вдогонку вопрос :
как в тех же макросах сделать, чтобы перед вставленными данными, в той же строке в ячейку, прямо перед цифрами добавлялась некая аббревиатура (ну скажем ТТТ) залитая от таким зеленым цветом "Color = 5296274". Это требуется, чтобы можно было понимать что есть что.
Пример прилагаю
К сообщению приложен файл: 6363429.xlsm (17.2 Kb)
 
Ответить
СообщениеСпасибо за оба варианта! Сидел разбирался как переназначить копирование - разобрался!
Оба работают как надо. Только второй ( от Бороды) всасывает и вставляет еще и цвет заливки . Сейчас думаю какой лучше использовать.
Вдогонку вопрос :
как в тех же макросах сделать, чтобы перед вставленными данными, в той же строке в ячейку, прямо перед цифрами добавлялась некая аббревиатура (ну скажем ТТТ) залитая от таким зеленым цветом "Color = 5296274". Это требуется, чтобы можно было понимать что есть что.
Пример прилагаю

Автор - Serge1400
Дата добавления - 30.05.2018 в 17:50
_Boroda_ Дата: Среда, 30.05.2018, 18:08 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16672
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так?
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    r1_ = Range("B" & Rows.Count).End(3).Row
    With Range("B" & r1_).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    With Range("A" & r1_ + 2)
        .Value = "ТТТ"
        .Interior.Color = 5296274 'зеленый как в файле - 5287936
        .Borders.Weight = xlMedium
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак?
[vba]
Код
Sub tt()
    Application.ScreenUpdating = 0
    r1_ = Range("B" & Rows.Count).End(3).Row
    With Range("B" & r1_).Resize(1, 3)
        .Copy .Offset(2)
        .Offset(2).Value = .Value
    End With
    With Range("A" & r1_ + 2)
        .Value = "ТТТ"
        .Interior.Color = 5296274 'зеленый как в файле - 5287936
        .Borders.Weight = xlMedium
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 30.05.2018 в 18:08
Serge1400 Дата: Среда, 30.05.2018, 18:44 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Так?
Sub tt()

Ага, именно так! Спасибо!
К сообщению приложен файл: 4568498.xlsm (17.2 Kb)
 
Ответить
Сообщение
Так?
Sub tt()

Ага, именно так! Спасибо!

Автор - Serge1400
Дата добавления - 30.05.2018 в 18:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирования и вставка данных из последних заполненных ячеек (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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