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

Вход

Регистрация

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

 

= Мир MS Excel/Сохранение данных, расположенных снизу умных и сводных табли - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение данных, расположенных снизу умных и сводных табли (Сводные таблицы/Pivot Table)
Сохранение данных, расположенных снизу умных и сводных табли
VadimSh Дата: Понедельник, 09.10.2023, 22:26 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
Добрый вечер. Помогите пожалуйста решить проблему. На Листе 1 имеется умная таблица, на Листе 2 - сводная. На листах снизу этих таблиц имеются данные, которые должны сохраниться и опускаться вниз при расширении данных таблиц. Нашел где-то решение для 2 умных таблиц, расположенных друг над другом. Вроде внедрил для Листа 2, но для этого пришлось заводить еще одну (пустую) умную таблицу.

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица2").Row
        If b - a = 3 Then
            Rows(a + 1).Insert Shift:=xlDown
            Rows(a * 2 + 2).Insert Shift:=xlDown
        End If
    End If
End Sub
[/vba]

Но для Сводной (Лист 1) ничего не получается. Может быть есть другое решение?. Заранее спасибо
К сообщению приложен файл: 2222.xlsm (24.9 Kb)
 
Ответить
СообщениеДобрый вечер. Помогите пожалуйста решить проблему. На Листе 1 имеется умная таблица, на Листе 2 - сводная. На листах снизу этих таблиц имеются данные, которые должны сохраниться и опускаться вниз при расширении данных таблиц. Нашел где-то решение для 2 умных таблиц, расположенных друг над другом. Вроде внедрил для Листа 2, но для этого пришлось заводить еще одну (пустую) умную таблицу.

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица2").Row
        If b - a = 3 Then
            Rows(a + 1).Insert Shift:=xlDown
            Rows(a * 2 + 2).Insert Shift:=xlDown
        End If
    End If
End Sub
[/vba]

Но для Сводной (Лист 1) ничего не получается. Может быть есть другое решение?. Заранее спасибо

Автор - VadimSh
Дата добавления - 09.10.2023 в 22:26
Serge_007 Дата: Понедельник, 09.10.2023, 23:03 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Решение выложил здесь


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеРешение выложил здесь

Автор - Serge_007
Дата добавления - 09.10.2023 в 23:03
MikeVol Дата: Понедельник, 09.10.2023, 23:56 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
но для этого пришлось заводить еще одну (пустую) умную таблицу

Можно и без дополнительной таблицы. Удалите её и вставьте следуйщий код вместо вашего кода: [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Таблица1")
    Dim tblHeader   As Range: Set tblHeader = tbl.HeaderRowRange
    Dim tblRow      As ListRow: Set tblRow = tbl.ListRows(tbl.ListRows.Count)
    Dim adRow       As Long: adRow = tblHeader.Row + tblRow.Index
    adRow = adRow + 2

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        Rows(adRow).Insert Shift:=xlDown
    End If

End Sub
[/vba]
Удачи.


Ученик.
 
Ответить
Сообщение
но для этого пришлось заводить еще одну (пустую) умную таблицу

Можно и без дополнительной таблицы. Удалите её и вставьте следуйщий код вместо вашего кода: [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Таблица1")
    Dim tblHeader   As Range: Set tblHeader = tbl.HeaderRowRange
    Dim tblRow      As ListRow: Set tblRow = tbl.ListRows(tbl.ListRows.Count)
    Dim adRow       As Long: adRow = tblHeader.Row + tblRow.Index
    adRow = adRow + 2

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then
        Rows(adRow).Insert Shift:=xlDown
    End If

End Sub
[/vba]
Удачи.

Автор - MikeVol
Дата добавления - 09.10.2023 в 23:56
VadimSh Дата: Вторник, 10.10.2023, 11:50 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
Спасибо за помощь. С кодом MikeVol работает на листе с умной таблицей. Проблема возникла со сводной таблицей. В отличии от умных таблиц которые могут увеличиваются на 1 строку сводная таблица при обновлении может увеличиться на любое количество строк.
Например сводная таблица занимает сроки с 1 по 10. В 12 строке и ниже имеются другие Данные, которые не относятся к сводной таблице. После добавления данных в умной таблице и обновлении сводной она стала занимать строки с 1 по 15 (добавились 5 строк), при этом затерло все что было с 12 по 15 строку. Как реализовать так что-бы при обновлении сводной таблицы нужные мне строки смещались вниз на то количество строк, что добавились в сводную таблицу и данные не терялись?
 
Ответить
СообщениеСпасибо за помощь. С кодом MikeVol работает на листе с умной таблицей. Проблема возникла со сводной таблицей. В отличии от умных таблиц которые могут увеличиваются на 1 строку сводная таблица при обновлении может увеличиться на любое количество строк.
Например сводная таблица занимает сроки с 1 по 10. В 12 строке и ниже имеются другие Данные, которые не относятся к сводной таблице. После добавления данных в умной таблице и обновлении сводной она стала занимать строки с 1 по 15 (добавились 5 строк), при этом затерло все что было с 12 по 15 строку. Как реализовать так что-бы при обновлении сводной таблицы нужные мне строки смещались вниз на то количество строк, что добавились в сводную таблицу и данные не терялись?

Автор - VadimSh
Дата добавления - 10.10.2023 в 11:50
MikeVol Дата: Вторник, 10.10.2023, 13:41 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
VadimSh, Доброго времени суток. К сожелению мной было найдена ошибка в моём коде которая добовляло строки ниже независимо от добавление новой строки в Умную таблицу. При любом изминение в этой Умной таблице приводило к добавлению строк ниже данной таблицы. Вот изменённый код который отслеживает изминение только во втором столбце (Наименование ) а не во всей таблице: [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Таблица1")
    Dim tblHeader   As Range: Set tblHeader = tbl.HeaderRowRange
    Dim tblCol      As ListColumn: Set tblCol = tbl.ListColumns("Наименование ")

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then

        If Not Intersect(Target, tblCol.DataBodyRange) Is Nothing Then
            Dim adRow As Long: adRow = tblHeader.Row + tbl.ListRows(tbl.ListRows.Count).Index + 2
            Rows(adRow).Insert Shift:=xlDown
        End If

    End If

End Sub
[/vba]


Ученик.

Сообщение отредактировал MikeVol - Вторник, 10.10.2023, 13:41
 
Ответить
СообщениеVadimSh, Доброго времени суток. К сожелению мной было найдена ошибка в моём коде которая добовляло строки ниже независимо от добавление новой строки в Умную таблицу. При любом изминение в этой Умной таблице приводило к добавлению строк ниже данной таблицы. Вот изменённый код который отслеживает изминение только во втором столбце (Наименование ) а не во всей таблице: [vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl         As ListObject: Set tbl = ListObjects("Таблица1")
    Dim tblHeader   As Range: Set tblHeader = tbl.HeaderRowRange
    Dim tblCol      As ListColumn: Set tblCol = tbl.ListColumns("Наименование ")

    If Not Intersect(Target, tbl.DataBodyRange) Is Nothing Then

        If Not Intersect(Target, tblCol.DataBodyRange) Is Nothing Then
            Dim adRow As Long: adRow = tblHeader.Row + tbl.ListRows(tbl.ListRows.Count).Index + 2
            Rows(adRow).Insert Shift:=xlDown
        End If

    End If

End Sub
[/vba]

Автор - MikeVol
Дата добавления - 10.10.2023 в 13:41
VadimSh Дата: Вторник, 10.10.2023, 17:02 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
MikeVol, спасибо еще раз. Я и не обратил внимание на ошибку в Вашем коде. Поправил и обратил внимание, что и 2 код тоже работает неверно. Добавление строк ниже таблицы должно происходить только при добавлении Новой строки в умную таблицу (увеличении количества строк). Данные в таблице могу меняться сколько угодно, в том числе и во 2 столбе
 
Ответить
СообщениеMikeVol, спасибо еще раз. Я и не обратил внимание на ошибку в Вашем коде. Поправил и обратил внимание, что и 2 код тоже работает неверно. Добавление строк ниже таблицы должно происходить только при добавлении Новой строки в умную таблицу (увеличении количества строк). Данные в таблице могу меняться сколько угодно, в том числе и во 2 столбе

Автор - VadimSh
Дата добавления - 10.10.2023 в 17:02
MikeVol Дата: Вторник, 10.10.2023, 19:39 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
VadimSh, Строка добовляються ниже умной таблицы только когда вы по столбцу Наименование © под умной таблице (первая пустая строка) вносите данные. После, эта строка подтягивается в структуру умной таблицы и Только тогда код добавляет пустую строку, промежуток между умной таблицы и данными под ней так и остаются в 6 строк. И не реагирует при внесение в другие столбцы. Проверьте.
К сообщению приложен файл: 10_10_2023_exw_sokhranenie_dan.xlsm (33.1 Kb)


Ученик.

Сообщение отредактировал MikeVol - Вторник, 10.10.2023, 22:53
 
Ответить
СообщениеVadimSh, Строка добовляються ниже умной таблицы только когда вы по столбцу Наименование © под умной таблице (первая пустая строка) вносите данные. После, эта строка подтягивается в структуру умной таблицы и Только тогда код добавляет пустую строку, промежуток между умной таблицы и данными под ней так и остаются в 6 строк. И не реагирует при внесение в другие столбцы. Проверьте.

Автор - MikeVol
Дата добавления - 10.10.2023 в 19:39
VadimSh Дата: Вторник, 10.10.2023, 22:07 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
MikeVol, еще раз проверил Ваш код. Он добавляет пустую строку при любом изменении в Наименовании (В). А нужно чтобы при добавлении любых данных (не только Наименование) в первую пустую строку умной таблицы. Файл прикладываю
К сообщению приложен файл: 0509000.xlsm (26.1 Kb)
 
Ответить
СообщениеMikeVol, еще раз проверил Ваш код. Он добавляет пустую строку при любом изменении в Наименовании (В). А нужно чтобы при добавлении любых данных (не только Наименование) в первую пустую строку умной таблицы. Файл прикладываю

Автор - VadimSh
Дата добавления - 10.10.2023 в 22:07
MikeVol Дата: Вторник, 10.10.2023, 22:50 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
VadimSh, Вы как вообще собираетесь работать с данной таблицей? По моей логике, вносим данные в колонку Наименование ©, строка подтягивается в структуру умной таблицы. И только после этого вносим все остальные данные в 20 января, 20 февраля и так далее. Но никак не иначе! Если вы подругому вносите данные, то Пожалуйста, используйте дальше свой код и
еще одну (пустую) умную таблицу

Даёшь человеку решение а он по старинке... Удачи вам далее в ваших непонятных действиях с данным файлом.


Ученик.

Сообщение отредактировал MikeVol - Вторник, 10.10.2023, 22:53
 
Ответить
СообщениеVadimSh, Вы как вообще собираетесь работать с данной таблицей? По моей логике, вносим данные в колонку Наименование ©, строка подтягивается в структуру умной таблицы. И только после этого вносим все остальные данные в 20 января, 20 февраля и так далее. Но никак не иначе! Если вы подругому вносите данные, то Пожалуйста, используйте дальше свой код и
еще одну (пустую) умную таблицу

Даёшь человеку решение а он по старинке... Удачи вам далее в ваших непонятных действиях с данным файлом.

Автор - MikeVol
Дата добавления - 10.10.2023 в 22:50
VadimSh Дата: Четверг, 12.10.2023, 11:49 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
MikeVol, спасибо за ваши ответы. Я правильно понял в вашем коде?
В первом варианте вашего кода строка добавлялась при:
1. Изменении/правке любой имеющейся ячейки в умной таблице (не правильно)
2. При вводе любых данных в новую строку умной таблицы (правильно)
Во втором варианте вашего кода строка добавлялась при:
1. Изменении/правке любой имеющейся ячейки в столбце "Наименование" (не правильно)
2. При вводе "Наименования" в новую строку умной таблицы (не правильно).
Должно быть так. Строка вставляется только при одном условии:
Ввод любых данных в новую строку умной таблицы (таблица расширяется).

Если это нельзя сделать, то просто придется постоянно удалять лишние создаваемые строки.
 
Ответить
СообщениеMikeVol, спасибо за ваши ответы. Я правильно понял в вашем коде?
В первом варианте вашего кода строка добавлялась при:
1. Изменении/правке любой имеющейся ячейки в умной таблице (не правильно)
2. При вводе любых данных в новую строку умной таблицы (правильно)
Во втором варианте вашего кода строка добавлялась при:
1. Изменении/правке любой имеющейся ячейки в столбце "Наименование" (не правильно)
2. При вводе "Наименования" в новую строку умной таблицы (не правильно).
Должно быть так. Строка вставляется только при одном условии:
Ввод любых данных в новую строку умной таблицы (таблица расширяется).

Если это нельзя сделать, то просто придется постоянно удалять лишние создаваемые строки.

Автор - VadimSh
Дата добавления - 12.10.2023 в 11:49
VadimSh Дата: Четверг, 12.10.2023, 12:01 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
Тут мне кажется лучше отредактировать код с 2-мя умными таблицами. Моих знаний не хватает, поэтому прошу помощи.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
a = Target.Row
b = Range("Таблица2").Row
If b - a = 3 Then
Rows(a + 1).Insert Shift:=xlDown
End If
End If
End Sub
[/vba]
И как это реализовать со сводной таблицей?


Сообщение отредактировал VadimSh - Четверг, 12.10.2023, 12:27
 
Ответить
СообщениеТут мне кажется лучше отредактировать код с 2-мя умными таблицами. Моих знаний не хватает, поэтому прошу помощи.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
a = Target.Row
b = Range("Таблица2").Row
If b - a = 3 Then
Rows(a + 1).Insert Shift:=xlDown
End If
End If
End Sub
[/vba]
И как это реализовать со сводной таблицей?

Автор - VadimSh
Дата добавления - 12.10.2023 в 12:01
Nic70y Дата: Четверг, 12.10.2023, 15:19 | Сообщение № 12
Группа: Друзья
Ранг: Экселист
Сообщений: 8792
Репутация: 2293 ±
Замечаний: 0% ±

Excel 2010
Нашел где-то

здесь
для одной таблицы
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        If b + c - 1 = a Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub
[/vba]
на счет сводной
я бы наверное обратился к исходным данным и определил куда сдвинуть строки
К сообщению приложен файл: 720.xlsm (23.5 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Четверг, 12.10.2023, 15:24
 
Ответить
Сообщение
Нашел где-то

здесь
для одной таблицы
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        If b + c - 1 = a Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub
[/vba]
на счет сводной
я бы наверное обратился к исходным данным и определил куда сдвинуть строки

Автор - Nic70y
Дата добавления - 12.10.2023 в 15:19
MikeVol Дата: Четверг, 12.10.2023, 19:06 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Nic70y, Приветсвую вас. Теперь пробуйте добавить запись, скажем в 16-ю строку. И теперь в той-же строке отредактируйте запись. Как, строка ещё одна добавилась? Но она не должна добавляться. VadimSh необходимо держать разрыв (6 строк) между умной таблицей (Таблица1) и теми данными что идут уже под ней.


Ученик.

Сообщение отредактировал MikeVol - Четверг, 12.10.2023, 19:07
 
Ответить
СообщениеNic70y, Приветсвую вас. Теперь пробуйте добавить запись, скажем в 16-ю строку. И теперь в той-же строке отредактируйте запись. Как, строка ещё одна добавилась? Но она не должна добавляться. VadimSh необходимо держать разрыв (6 строк) между умной таблицей (Таблица1) и теми данными что идут уже под ней.

Автор - MikeVol
Дата добавления - 12.10.2023 в 19:06
Nic70y Дата: Пятница, 13.10.2023, 08:03 | Сообщение № 14
Группа: Друзья
Ранг: Экселист
Сообщений: 8792
Репутация: 2293 ±
Замечаний: 0% ±

Excel 2010
MikeVol, здравствуйте.
есть такое, недотестил, для данного случая можно добавить проверку
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        d = Target.Offset(1, 0)
        If b + c - 1 = a And d <> "" Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub
[/vba]


ЮMoney 41001841029809
 
Ответить
СообщениеMikeVol, здравствуйте.
есть такое, недотестил, для данного случая можно добавить проверку
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        d = Target.Offset(1, 0)
        If b + c - 1 = a And d <> "" Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 13.10.2023 в 08:03
MikeVol Дата: Пятница, 13.10.2023, 11:23 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Nic70y, Приветсвую вас. Всё равно не то. VadimSh, Здравствуйте, пробуйте следуйщий код.[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a           As Long: a = 3

    Do While Cells(a, 2).Value <> ""
        a = a + 1
    Loop

    Dim b           As Long: b = a

    Do While Cells(b, 2).Value = ""
        b = b + 1
    Loop

    If b - a < 6 Then
        Rows(a + 1).Insert Shift:=xlDown
    End If

End Sub
[/vba]
Протестил, вроде бы все ваши критерии
Должно быть так. Строка вставляется только при одном условии:
Ввод любых данных в новую строку умной таблицы (таблица расширяется).

Протестируйте и дайте знать. Удачи.

UPDATE! Приложил файл пример.
К сообщению приложен файл: 13_10_2023_exw_sokhranenie_dan.xlsm (26.0 Kb)


Ученик.

Сообщение отредактировал MikeVol - Пятница, 13.10.2023, 11:29
 
Ответить
СообщениеNic70y, Приветсвую вас. Всё равно не то. VadimSh, Здравствуйте, пробуйте следуйщий код.[vba]
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a           As Long: a = 3

    Do While Cells(a, 2).Value <> ""
        a = a + 1
    Loop

    Dim b           As Long: b = a

    Do While Cells(b, 2).Value = ""
        b = b + 1
    Loop

    If b - a < 6 Then
        Rows(a + 1).Insert Shift:=xlDown
    End If

End Sub
[/vba]
Протестил, вроде бы все ваши критерии
Должно быть так. Строка вставляется только при одном условии:
Ввод любых данных в новую строку умной таблицы (таблица расширяется).

Протестируйте и дайте знать. Удачи.

UPDATE! Приложил файл пример.

Автор - MikeVol
Дата добавления - 13.10.2023 в 11:23
VadimSh Дата: Пятница, 13.10.2023, 13:09 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        d = Target.Offset(1, 0)
        If b + c - 1 = a And d <> "" Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub

Nic70y спасибо за помощь. Есть только одна проблема с этим кодом: в умной таблице если вырезать строку и попытаться ее вставить ваш код выдает ошибку (без кода работает)
 
Ответить
Сообщение
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица1").Row
        c = Range("Таблица1").Rows.Count
        d = Target.Offset(1, 0)
        If b + c - 1 = a And d <> "" Then
            Rows(a + 1).Insert
            Rows(a + 1).Clear
        End If
    End If
End Sub

Nic70y спасибо за помощь. Есть только одна проблема с этим кодом: в умной таблице если вырезать строку и попытаться ее вставить ваш код выдает ошибку (без кода работает)

Автор - VadimSh
Дата добавления - 13.10.2023 в 13:09
VadimSh Дата: Пятница, 13.10.2023, 13:44 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
MikeVol еще раз спасибо. Все работает. Не сочтите за наглость. А со сводной таблицей (Лист 1) что-то подобное можете подсказать?
К сообщению приложен файл: 5190274.xlsm (26.0 Kb)
 
Ответить
СообщениеMikeVol еще раз спасибо. Все работает. Не сочтите за наглость. А со сводной таблицей (Лист 1) что-то подобное можете подсказать?

Автор - VadimSh
Дата добавления - 13.10.2023 в 13:44
MikeVol Дата: Пятница, 13.10.2023, 18:33 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
VadimSh, Вопрос к вам. А на Листе2 (Таблица1) в колонке "Наименование " так и будут такие цифры идти или всё же будут какие-то уникальные наименования?


Ученик.
 
Ответить
СообщениеVadimSh, Вопрос к вам. А на Листе2 (Таблица1) в колонке "Наименование " так и будут такие цифры идти или всё же будут какие-то уникальные наименования?

Автор - MikeVol
Дата добавления - 13.10.2023 в 18:33
VadimSh Дата: Вторник, 17.10.2023, 10:00 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
Будут уникальные наименования
 
Ответить
СообщениеБудут уникальные наименования

Автор - VadimSh
Дата добавления - 17.10.2023 в 10:00
MikeVol Дата: Вторник, 17.10.2023, 16:32 | Сообщение № 20
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
VadimSh, Доброго времени суток. Проверяйте.
К сообщению приложен файл: 17_10_2023_exw_sokhranenie_dan.xlsm (33.3 Kb)


Ученик.
 
Ответить
СообщениеVadimSh, Доброго времени суток. Проверяйте.

Автор - MikeVol
Дата добавления - 17.10.2023 в 16:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение данных, расположенных снизу умных и сводных табли (Сводные таблицы/Pivot Table)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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