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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование данных в таблице - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Копирование данных в таблице
Chelovekov Дата: Пятница, 05.05.2023, 00:59 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 313
Репутация: 0 ±
Замечаний: 80% ±

Excel 2016
Здравствуйте, Уважаемые Форумчане. Прошу, Вас помочь, решить проблему. Нужно написать макрос или формулу, если это возможно, которая будет выделять область для копирования, и ее копировать для дальнейшего использования, критерием для выделения области будет служить выбранная дата. То есть, согласно дате нужно выделить и скопировать, все ячейки, которые стоят справа от даты, вместе с датой.
Пример прилагаю
Заранее благодарен.
К сообщению приложен файл: 4784990.xlsx (14.0 Kb)
 
Ответить
СообщениеЗдравствуйте, Уважаемые Форумчане. Прошу, Вас помочь, решить проблему. Нужно написать макрос или формулу, если это возможно, которая будет выделять область для копирования, и ее копировать для дальнейшего использования, критерием для выделения области будет служить выбранная дата. То есть, согласно дате нужно выделить и скопировать, все ячейки, которые стоят справа от даты, вместе с датой.
Пример прилагаю
Заранее благодарен.

Автор - Chelovekov
Дата добавления - 05.05.2023 в 00:59
elovkov Дата: Пятница, 05.05.2023, 09:59 | Сообщение № 2
Группа: Друзья
Ранг: Обитатель
Сообщений: 394
Репутация: 53 ±
Замечаний: 0% ±

Excel 2013
можно так, минус - в итоговой таблице заранее должно хватать строк
К сообщению приложен файл: 1209023.xlsx (12.7 Kb)


Умное лицо это еще не признак ума. Все глупости на земле делаются именно с этим выражением лица
 
Ответить
Сообщениеможно так, минус - в итоговой таблице заранее должно хватать строк

Автор - elovkov
Дата добавления - 05.05.2023 в 09:59
Chelovekov Дата: Пятница, 05.05.2023, 14:15 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 313
Репутация: 0 ±
Замечаний: 80% ±

Excel 2016
Спасибо огромное, но если у кого будет варианты с макросом, очень будет не плохо.
hands
 
Ответить
СообщениеСпасибо огромное, но если у кого будет варианты с макросом, очень будет не плохо.
hands

Автор - Chelovekov
Дата добавления - 05.05.2023 в 14:15
Serge_007 Дата: Пятница, 05.05.2023, 14:53 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
[vba]
Код
Sub Chelovekov()
    Dim LR1&, LR2&, rR As Range
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                Range("j" & LR2) = CDate(rR)
                Range("k" & LR2) = rR.Offset(0, 1)
                Range("l" & LR2) = rR.Offset(0, 2)
            End If
        Next rR
End Sub
[/vba]
К сообщению приложен файл: 20230505_chelovekov.xls (38.0 Kb)


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение[vba]
Код
Sub Chelovekov()
    Dim LR1&, LR2&, rR As Range
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                Range("j" & LR2) = CDate(rR)
                Range("k" & LR2) = rR.Offset(0, 1)
                Range("l" & LR2) = rR.Offset(0, 2)
            End If
        Next rR
End Sub
[/vba]

Автор - Serge_007
Дата добавления - 05.05.2023 в 14:53
cmivadwot Дата: Суббота, 06.05.2023, 03:02 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 488
Репутация: 89 ±
Замечаний: 0% ±

365
Chelovekov, не совсем то, но....
К сообщению приложен файл: 5505192.xlsx (225.1 Kb)
 
Ответить
СообщениеChelovekov, не совсем то, но....

Автор - cmivadwot
Дата добавления - 06.05.2023 в 03:02
Chelovekov Дата: Понедельник, 08.05.2023, 12:50 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 313
Репутация: 0 ±
Замечаний: 80% ±

Excel 2016
Спасибо огромное ребята hands
 
Ответить
СообщениеСпасибо огромное ребята hands

Автор - Chelovekov
Дата добавления - 08.05.2023 в 12:50
Chelovekov Дата: Среда, 17.05.2023, 15:55 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 313
Репутация: 0 ±
Замечаний: 80% ±

Excel 2016
Уважаемые Форумчане, могли бы Вы подредактировать данный макрос, с условием что нужно копировать и вставить данные, не в активный лист, а в другой лист. Имя листа Лист2. А так же после последующего копирование, таблица куда копируется данные очищалось от старых данных.
Пример прилагаю.
Заранее благодарен.

[vba]
Код
Sub Chelovekov()
Dim LR1&, LR2&, rR As Range
LR1 = Cells(Rows.Count, "a").End(xlUp).Row
For Each rR In Range("a1:a" & LR1)
LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
If rR = [e2] Then
Range("j" & LR2) = CDate(rR)
Range("k" & LR2) = rR.Offset(0, 1)
Range("l" & LR2) = rR.Offset(0, 2)
End If
Next rR
End Sub
[/vba]
К сообщению приложен файл: primer_kopir.xls (38.5 Kb)


Сообщение отредактировал Chelovekov - Среда, 17.05.2023, 15:56
 
Ответить
СообщениеУважаемые Форумчане, могли бы Вы подредактировать данный макрос, с условием что нужно копировать и вставить данные, не в активный лист, а в другой лист. Имя листа Лист2. А так же после последующего копирование, таблица куда копируется данные очищалось от старых данных.
Пример прилагаю.
Заранее благодарен.

[vba]
Код
Sub Chelovekov()
Dim LR1&, LR2&, rR As Range
LR1 = Cells(Rows.Count, "a").End(xlUp).Row
For Each rR In Range("a1:a" & LR1)
LR2 = Cells(Rows.Count, "j").End(xlUp).Row + 1
If rR = [e2] Then
Range("j" & LR2) = CDate(rR)
Range("k" & LR2) = rR.Offset(0, 1)
Range("l" & LR2) = rR.Offset(0, 2)
End If
Next rR
End Sub
[/vba]

Автор - Chelovekov
Дата добавления - 17.05.2023 в 15:55
Serge_007 Дата: Среда, 17.05.2023, 16:26 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
[vba]
Код
Sub Chelovekov2()
    Dim LR1&, LR2&, LR3&, rR As Range
    LR3 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row
    Sheets("Лист2").Range("j2:l" & LR3).ClearContents
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                With Sheets("Лист2")
                .Range("j" & LR2) = CDate(rR)
                .Range("k" & LR2) = rR.Offset(0, 1)
                .Range("l" & LR2) = rR.Offset(0, 2)
                End With
            End If
        Next
End Sub
[/vba]
К сообщению приложен файл: 20230517_chelovekov.xls (43.0 Kb)


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение[vba]
Код
Sub Chelovekov2()
    Dim LR1&, LR2&, LR3&, rR As Range
    LR3 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row
    Sheets("Лист2").Range("j2:l" & LR3).ClearContents
        LR1 = Cells(Rows.Count, "a").End(xlUp).Row
        For Each rR In Range("a1:a" & LR1)
            LR2 = Sheets("Лист2").Cells(Rows.Count, "j").End(xlUp).Row + 1
            If rR = [e2] Then
                With Sheets("Лист2")
                .Range("j" & LR2) = CDate(rR)
                .Range("k" & LR2) = rR.Offset(0, 1)
                .Range("l" & LR2) = rR.Offset(0, 2)
                End With
            End If
        Next
End Sub
[/vba]

Автор - Serge_007
Дата добавления - 17.05.2023 в 16:26
Chelovekov Дата: Среда, 17.05.2023, 22:50 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 313
Репутация: 0 ±
Замечаний: 80% ±

Excel 2016
Огромное спасибо hands
 
Ответить
СообщениеОгромное спасибо hands

Автор - Chelovekov
Дата добавления - 17.05.2023 в 22:50
  • Страница 1 из 1
  • 1
Поиск:

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