Як зберегти таблицю розширюваною, вставляючи рядок таблиці в захищений аркуш у Excel?

Функція автоматичного розширення таблиці буде втрачена після захисту робочого аркуша в Excel. Наприклад, на вашому захищеному аркуші є таблиця з назвою Table1, коли ви вводите що-небудь під останнім рядком, таблиця автоматично не розширюватиметься, щоб включити новий рядок. Чи існує спосіб зберегти таблицю розширюваною, вставляючи новий рядок у захищений аркуш? Метод у цій статті може допомогти вам його досягти.

Зберігайте таблицю розширюваною, вставляючи рядок таблиці в захищений аркуш із кодом VBA

Зберігайте таблицю розширюваною, вставляючи рядок таблиці в захищений аркуш із кодом VBA

Дивовижний! Використання ефективних вкладок в Excel, як Chrome, Firefox та Safari!

Заощаджуйте 50% свого часу та зменшуйте тисячі клацань миші щодня!

Як показано на знімку екрана, таблиця з іменем Table1 на вашому аркуші, а останній стовпець таблиці - це стовпець формули. Тепер вам потрібно захистити робочий аркуш, щоб запобігти зміні стовпця формули, але дозволити розгорнути таблицю, вставивши новий рядок і призначивши нові дані в нові клітинки. Будь ласка, виконайте наступне.

1. клацання Розробник > Insert > Кнопка (контроль форми) вставити a Контроль форми на робочому аркуші.

2. У спливаючому Призначити макрос у діалоговому вікні натисніть новий кнопки.

3 В Microsoft Visual Basic для додатків вікно, скопіюйте та вставте наведений нижче код VBA між нижче та End Sub абзаців у код вікна.

Код VBA: Зберігайте таблицю розширюваною, вставляючи рядок таблиці в захищений аркуш

 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    Set tableRg = ActiveSheet.ListObjects("Table4").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True

примітки:

1). У коді число «123» - це пароль, який ви будете використовувати для захисту робочого аркуша.

2). Будь ласка, змініть назву таблиці та назву стовпця, що містить формулу, яку ви захищатимете.

4 Натисніть кнопку інший + Q клавіші, щоб закрити вікно Microsoft Visual Basic for Applications.

5. Виділіть клітинки таблиці, до яких потрібно призначити нові дані, крім стовпця формули, а потім натисніть Ctrl + 1 ключі, щоб відкрити Формат ячеек діалогове вікно. В Формат ячеек діалоговому вікні, зніміть прапорець біля Заблокований , а потім клацніть на OK кнопку. Дивіться знімок екрана:

6. Тепер захистіть свій аркуш паролем, який ви вказали в коді VBA.

Відтепер після натискання кнопки «Форма керування» на захищеному аркуші таблицю можна буде розширювати, вставляючи новий рядок, як показано нижче.

примітки: ви можете змінити таблицю, крім стовпця формули на захищеному аркуші.

Статті по темі:

Найкращі інструменти для підвищення продуктивності офісу

Kutools for Excel Вирішує більшість ваших проблем і підвищує вашу продуктивність на 80%

Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
Понад 300 потужних функцій. Підтримує Office / Excel 2007-2021 і 365. Підтримує всі мови. Легке розгортання на вашому підприємстві чи в організації. 30-денна безкоштовна пробна версія повних функцій. 60-денна гарантія повернення грошей.

Детальніше ... Завантажити безкоштовно... Придбати ...

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!

Детальніше ... Завантажити безкоштовно... Придбати ...

Коментарі (18)

Поки немає оцінок. Оцініть першим!

Бренді

про 4 років тому

# 26500

Цей коментар був мінімізований модератором на сайті

Тож я спробував це, але він додає новий рядок у нижній частині книги в рядку 1048576, однак моя таблиця містить лише близько 800 записів. Я поняття не маю, чому він це робить!

відповісти

кристал Бренді

про 4 років тому

# 26501

Цей коментар був мінімізований модератором на сайті

Привіт Брінді!
Код оновлено, проблема вирішена, будь ласка, спробуйте та дякуємо за коментар.

відповісти

доповідь

Алі кристал

про 4 років тому

# 26502

Цей коментар був мінімізований модератором на сайті

Привіт, Кристал, проблема та сама. Я створив для себе нову таблицю лише з 2 рядками. Після натискання кнопки список розгортається до кінця таблиці без додавання рядків. Його слід додати до рядка номер 3.

відповісти

Алі кристал

про 4 років тому

# 26503

Цей коментар був мінімізований модератором на сайті

відповісти

доповідь

Mac

про 4 років тому

# 28550

Цей коментар був мінімізований модератором на сайті

Спробуйте цей код Vba, щоб додати новий рядок у вашу таблицю

Підкладка_рядка_Додати()
Dim pswStr як рядок
pswStr = "123"
On Error Resume Next
Application.ScreenUpdating = Невірний
ActiveSheet.Unprotect Password:=pswStr
ActiveSheet.Range("D8").Вибрати
«D8 — заголовок таблиці
Діапазон("Таблиця1[[#Заголовки],[Усього]]"). Виберіть
Selection.End(xlDown).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=False
ActiveSheet.Protect Пароль:=pswStr

End Sub
.

відповісти

кристал Mac

про 4 років тому

# 28551

Цей коментар був мінімізований модератором на сайті

Привіт Мак!
Дякую, що поділилися.

відповісти

доповідь

Сохаель аль-Хусейні Mac

про 3 років тому

# 28552

Цей коментар був мінімізований модератором на сайті

Використання запропонованого (Selection.ListObject.ListRows.Add AlwaysInsert:=False) вирішує подібну проблему для мене з оригінальним кодом, де новий повний рядок (розширює клітинку, що містить формули) не буде додано до таблиці на набагато ширшому таблиця 51 колонка. Тож дякую, що поділилися та виправили Mac.

відповісти

Мішель

про 3 років тому

# 30336

Цей коментар був мінімізований модератором на сайті

Привіт, я використав наведений вище код і отримав таке повідомлення про помилку:
«Виконання коду перервано». Коли я клацаю на Debug, рядок 20 "Selection.ClearContents" виділено.

Коли я спочатку ввів код, він працював правильно.

Я змінив "Таблицю" на назву таблиці та змінив стовпець на назву стовпця, який я використовую. Я також змінив "Selection.Offset (x,-x).Select" відповідно до своїх потреб.

Будь-які пропозиції щодо того, чому це відбувається?

відповісти

доповідь

Олу

про 3 років тому

# 32756

Цей коментар був мінімізований модератором на сайті

Здравствуйте,

спочатку код працював, але після того, як я скопіював аркуш, він залишився протягом 24 годин, потім весь код зник. А тепер я не можу отримати доступ до робочого аркуша.

він постійно говорить мені неправильний пароль. І код зник. .

відповісти

берат

про 1 рік тому

# 38184

Цей коментар був мінімізований модератором на сайті

Merhaba Tablo ismini ve satır başlangıc yerlerini değiştirdiğim zaman kod çalışmıyor yardımcı olurmusunuz

відповісти

кристал берат

про 1 рік тому

# 38241

Цей коментар був мінімізований модератором на сайті

привіт,
Переконайтеся, що ви змінили в коді те саме ім’я таблиці та заголовок стовпця.
Я змінив назву таблиці та заголовок стовпця, щоб перевірити код, і він працює добре.
Ви отримували повідомлення про помилку? Мені потрібно дізнатися більше про вашу проблему, наприклад, вашу версію Excel. Чим детальніше ви опишете помилку, тим швидше ми зможемо її зрозуміти та вирішити.

відповісти

доповідь

Аліссон Юнс

близько 11 місяців тому

# 38424

Цей коментар був мінімізований модератором на сайті

Як створити кнопку для стирання рядків?

відповісти

Діана

близько 9 місяців тому

# 39590

Цей коментар був мінімізований модератором на сайті

Гола !!!
Tengo una tabla donde más de una columna está protegida.
La tabla tiene 17 columnas de las cuales 7 deben quedar bloqueadas porque poseen fórmulas.
Mi tabla arranca en celda A4

Estaba tratando de usar este código para probarlo, cambiando lo que verán abajo como "CLAVE", "MITABLA" y "AVISO 1" por mis nombres specifices:
Donde "AVISO 1" відповідає una de las columnas que está protegida.

Dim pswStr як рядок
'Оновлення до ExtendOffice 20181106
pswStr = "CLAVE"
On Error Resume Next
Application.ScreenUpdating = Невірний
ActiveSheet.Unprotect Password:=pswStr
ActiveSheet.Діапазон("A4").Вибрати
Діапазон ("MITABLA[[#Headers],[AVISO 1]]"). Виберіть
Selection.End(xlDown).Select
Selection.Offset(1, -16).Select
ActiveCell.FormulaR1C1 = "нове"
Пароль ActiveSheet.Protect:=pswStr, DrawingObjects:=False, _
Зміст:=Правда, Сценарії:=Хибно, _
AllowFormattingCells:=Правда, AllowFormattingColumns:=Правда, _
AllowFormattingRows:=Правда, AllowInsertingColumns:=Правда, _
AllowInsertingRows:=Правда, AllowInsertingHyperlinks:=Правда, _
AllowDeletingColumns:=Правда, AllowDeletingRows:=Правда, _
AllowSorting:=Правда, AllowFiltering:=Правда, _
AllowUsingPivotTables:=Правда
Вибір.CLEARCONTENTS
Application.ScreenUpdating = True

Lo que está haciendo el código tal cual como lo escribo es que en lugar de agregar una nueva línea a mi tabla, está colocando la palabra "new" en la última celda contenido de la columna "AVISO 1".

Серджен вимовляє 2 дуди:
1. ¿cómo podría hacer para determinar más de una columna protegida?
2. ¿por qué está haciendo esto el código definido?

Agradezco de antemano que me puedan ayudar! Estaré atenta.

відповісти

кристал Діана

близько 9 місяців тому

# 39715

Цей коментар був мінімізований модератором на сайті

Привіт Дайна,
1. Якщо 7 стовпців формули, які потрібно захистити, є послідовними в таблиці.
Наприклад, заголовками стовпців є gg, hh, ii, jj, kk, ll, mm, як показано на знімку екрана нижче. Ви можете застосувати наступний код VBA, щоб виконати це.

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/table.png

У цьому рядку Встановити xRg = Range("Таблиця3[[#Заголовки],[gg]:[мм]]").Зміщення(1, 0) у наступному коді вам просто потрібно ввести заголовки першого та останнього стовпців.

Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
     Set xRg = Range("Table3[[#Headers],[gg]:[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, xRg.Columns.Count)

    xRg.Resize(xRowCount - 1, xRg.Columns.Count).AutoFill Destination:=yRg, Type:=xlFillDefault
    

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub

2. Якщо 7 стовпців формули, які потрібно захистити, є розривними в таблиці. Застосуйте наступний код. У коді потрібно вручну вводити заголовки стовпців один за іншим.

Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table3[[#Headers],[gg]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[hh]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[ii]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[jj]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[kk]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
     Set xRg = Range("Table3[[#Headers],[ll]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub

відповісти

доповідь

Рея

близько 7 місяців тому

# 40666

Цей коментар був мінімізований модератором на сайті

Привіт.

Дякую, що поділились. Хоча у мене є запитання... використовуючи код вище, я можу додавати по одному рядку. Як додати кілька рядків в один клік?

Спасибо заранее.

'Оновлення до ExtendOffice 20220826
Dim xRg, tableRg як діапазон
Dim xRowCount As Integer
Dim pswStr як рядок
pswStr = "123"
On Error Resume Next
Application.ScreenUpdating = Невірний
ActiveSheet.Unprotect Password:=pswStr

Установіть tableRg = ActiveSheet.ListObjects("Table4").Діапазон
xRowCount = tableRg.Rows.Count

Встановити xRg = Range("Таблиця4[[#Заголовки],[Усього]]").Зсув(1, 0)
Установіть yRg = xRg.Resize(xRowCount, 1)
xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

Пароль ActiveSheet.Protect:=pswStr, DrawingObjects:=False, _
Зміст:=Правда, Сценарії:=Хибно, _
AllowFormattingCells:=Правда, AllowFormattingColumns:=Правда, _
AllowFormattingRows:=Правда, AllowInsertingColumns:=Правда, _
AllowInsertingRows:=Правда, AllowInsertingHyperlinks:=Правда, _
AllowDeletingColumns:=Правда, AllowDeletingRows:=Правда, _
AllowSorting:=Правда, AllowFiltering:=Правда, _
AllowUsingPivotTables:=Правда
Application.ScreenUpdating = True

відповісти

прем

близько 7 місяців тому

# 40854

Цей коментар був мінімізований модератором на сайті

Код не працює.
Кілька помилок.

Dim xRg, tableRg As Range

xRg

є варіантом, а не діапазоном

yRg

не декларується взагалі

Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)

runtime error 1004
Коли я забираю TOTAL, це працює.
Він не працює з відображенням рядка підсумків, а також, коли я приховую рядок підсумків на стрічці.

Зазвичай ваш веб-сайт справді чудовий, але цю статтю потрібно вдосконалити.

відповісти

кристал прем

близько 7 місяців тому

# 40990

Цей коментар був мінімізований модератором на сайті

Привіт Прем,
Вам потрібно переконатися, що назва таблиці та заголовок стовпця, указані в коді, збігаються з назвою таблиці та заголовком стовпця на аркуші. Щоб уникнути помилки 1004, вам може знадобитися ввімкнути довірчий доступ до об’єктної моделі проекту VBA у вашому Excel: натисніть філе > Опції > Центр безпеки > Налаштування центру довіри > Налаштування макросу > а потім перевірте Довіряйте доступу до об’єктної моделі проекту VBA коробка

відповісти

доповідь

Луїс

близько 6 місяців тому

# 41307

Цей коментар був мінімізований модератором на сайті

Sub ButtonOut_Click()

Dim PswS як рядок
PswStr = "54321"

On Error Resume Next

Application.ScreenUpdating = Невірний
ActiveSheet.Unprotect Password:=PswStr

ActiveSheet.ListObjects("Таблиця1").ListRows.Add

ActiveSheet.Protect Password:=PswStr
Application.ScreenUpdating = True

End Sub

відповісти

There are no comments posted here yet