如何通過在Excel中受保護的工作表中插入表行來保持表可擴展？

在Excel中保護工作表後，表的自動擴展功能將丟失。例如，在受保護的工作表中有一個名為Table1的表，當您在最後一行下鍵入任何內容時，該表將不會自動擴展為包括新行。是否有通過在受保護的工作表中插入新行來保持表可擴展的方法？本文中的方法可以幫助您實現它。

通過使用VBA代碼在受保護的工作表中插入表行來保持表可擴展

通過使用VBA代碼在受保護的工作表中插入表行來保持表可擴展

驚人！在Excel中使用高效選項卡，例如Chrome，Firefox和Safari！

每天節省50％的時間，並減少數千次鼠標單擊！

如下面的屏幕快照所示，工作表中的一個名為Table1的表，該表的最後一列是公式列。現在，您需要保護工作表以防止更改公式列，但可以通過插入新行並將新數據分配給新單元格來擴展表。請執行以下操作。

1。點擊 開發人員 > 插入 > 按鈕（表單控件） 插入一個 表格控制 按鈕進入您的工作表。

2.在彈出 分配宏 對話框中，單擊全新按鈕。

3。在裡面 Microsoft Visual Basic for Applications 窗口，請在以下窗口之間複製並粘貼以下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應用程序”窗口。

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中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。
在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
將您的工作效率提高 50%，每天為您減少數百次鼠標點擊！

閱讀更多... 免費下載... 採購...

留言 (18)

還沒有評分。成為第一位評論！

布蘭迪

大約4年前

#26500

網站主持人對此評論進行了最小化

所以我嘗試了這個，但是它在第 1048576 行的工作簿底部添加了一個新行，但是我的表只有大約 800 條記錄。我不知道它為什麼這樣做！

水晶布蘭迪

大約4年前

#26501

網站主持人對此評論進行了最小化

嗨布林迪，
代碼已更新，問題已解決，請試一試，感謝您的評論。

即時報告

阿里水晶

大約4年前

#26502

網站主持人對此評論進行了最小化

嗨水晶，問題是一樣的。我為自己創建了一個只有 2 行的新表。單擊按鈕後，列表將展開到表格末尾而不添加任何行。它應該添加到第 3 行。

阿里水晶

大約4年前

#26503

網站主持人對此評論進行了最小化

嗨水晶，問題是一樣的。我為自己創建了一個只有 2 行的新表。單擊按鈕後，列表將展開到表格末尾而不添加任何行。它應該添加到第 3 行。

即時報告

Mac

大約3年前

#28550

網站主持人對此評論進行了最小化

試試這個 Vba 代碼在你的表中添加新行

子 Tab_Line_Add()
將 pswStr 調暗為字符串
pswStr = "123"
在錯誤恢復下一頁
Application.ScreenUpdating = False
ActiveSheet.Unprotect 密碼:=pswStr
ActiveSheet.Range("D8").Select
'D8 是表頭
Range("Table1[[#Headers],[Total]]").Select
Selection.End（xlDown）。選擇
選擇.ListObject.ListRows.Add AlwaysInsert:=False
ActiveSheet.Protect 密碼:=pswStr

END SUB
.

水晶 Mac

大約3年前

#28551

網站主持人對此評論進行了最小化

嗨，麥克，
感謝分享

即時報告

索哈爾侯賽尼 Mac

大約3年前

#28552

網站主持人對此評論進行了最小化

使用建議的 (Selection.ListObject.ListRows.Add AlwaysInsert:=False) 為我解決了與原始代碼類似的問題，其中一個新的完整行（向下擴展包含公式的單元格）不會添加到更寬的表格中表 51 列。所以感謝分享和修復 Mac。

米歇爾

大約3年前

#30336

網站主持人對此評論進行了最小化

您好，我使用了上面的代碼並收到以下錯誤消息：
“代碼執行已中斷”。當我單擊 Debug 時，第 20 行“Selection.ClearContents”被突出顯示。

當我最初輸入代碼時，它工作正常。

我將“表”更改為表的名稱，並將列更改為我正在使用的列的名稱。我還更改了“Selection.Offset (x,-x).Select”以滿足我的需要。

關於為什麼會發生這種情況的任何建議？

即時報告

奧盧

大約2年前

#32756

網站主持人對此評論進行了最小化

你好，

該代碼最初有效，但在我複制工作表後，它停留了 24 小時後，然後所有代碼都消失了。現在我無法訪問工作表。

它一直告訴我密碼錯誤。並且代碼消失了。 .

專利證書

大約8個月前

#38184

網站主持人對此評論進行了最小化

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

水晶專利證書

大約8個月前

#38241

網站主持人對此評論進行了最小化

嗨，
確保您已在代碼中更改為完全相同的表名和列標題。
我已經更改了表名和列標題來測試代碼，它運行良好。
你有沒有得到任何錯誤提示？我需要更具體地了解您的問題，例如您的 Excel 版本。您描述的錯誤越詳細，我們就越能更快地理解和解決它。

即時報告

艾莉森·瓊斯

大約7個月前

#38424

網站主持人對此評論進行了最小化

如何創建一個按鈕來擦除線條？

戴安娜

大約5個月前

#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 speciales:
Donde "AVISO 1" 對應一個 una de las columnas que está protegida。

將 pswStr 調暗為字符串
'更新 ExtendOffice 20181106
pswStr = "CLAVE"
在錯誤恢復下一頁
Application.ScreenUpdating = False
ActiveSheet.Unprotect 密碼:=pswStr
ActiveSheet.Range("A4").Select
範圍（“MITABLA[[#Headers],[AVISO 1]]”）。選擇
Selection.End（xlDown）。選擇
選擇.偏移量(1, -16).選擇
ActiveCell.FormulaR1C1 = "新"
ActiveSheet.Protect 密碼:=pswStr, DrawingObjects:=False, _
內容：=真，場景：=假，_
AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=True, AllowDeletingRows:=True, _
允許排序：=真，允許過濾：=真，_
允許使用數據透視表：=真
選擇.清除內容
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"。

Surgen 誘捕 2 個 dudas：
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。

水晶戴安娜

大約5個月前

#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("Table3[[#Headers],[gg]:[mm]]").Offset(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

即時報告

Amy

大約3個月前

#40666

網站主持人對此評論進行了最小化

你好。

感謝分享。雖然我有一個問題......通過使用上面的代碼，我可以一次添加一行。如何一鍵添加多行？

在此先感謝。

'更新 ExtendOffice 20220826
暗淡 xRg，tableRg 作為範圍
將 xRowCount 調暗為整數
將 pswStr 調暗為字符串
pswStr = "123"
在錯誤恢復下一頁
Application.ScreenUpdating = False
ActiveSheet.Unprotect 密碼:=pswStr

設置 tableRg = ActiveSheet.ListObjects("Table4").Range
xRowCount = tableRg.Rows.Count

設置 xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)
設置 yRg = xRg.Resize(xRowCount, 1)
xRg.Resize(xRowCount - 1, 1).AutoFill 目標：=yRg，類型：=xlFillDefault

ActiveSheet.Protect 密碼:=pswStr, DrawingObjects:=False, _
內容：=真，場景：=假，_
AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=True, AllowDeletingRows:=True, _
允許排序：=真，允許過濾：=真，_
允許使用數據透視表：=真
Application.ScreenUpdating = True

炳

大約3個月前

#40854

網站主持人對此評論進行了最小化

該代碼不起作用。
幾個錯誤。

Dim xRg, tableRg As Range

xRg

是變體而不是范圍

yRg

根本沒有聲明

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

運行時錯誤1004
當我拿走 TOTAL 時，它就起作用了。
它不適用於顯示的總行，當我在功能區中隱藏總行時也不行。

通常你的網站真的很棒，但這篇文章需要改進。

水晶炳

大約3個月前

#40990

網站主持人對此評論進行了最小化

嗨，總理，
您需要確保代碼中指定的表名和列標題與工作表中的表名和列標題匹配。為避免 1004 錯誤，您可能需要啟用 信任對 VBA 項目對像模型的訪問 在 Excel 中：單擊文件 > 選項 > 信託中心 > 信任中心設置 > 宏設置 > 然後檢查 信任對VBA項目對像模型的訪問 框。

即時報告

路易斯

大約2個月前

#41307

網站主持人對此評論進行了最小化

子 ButtonOut_Click()

將 PswS 調暗為字符串
PswStr = "54321"

在錯誤恢復下一頁

Application.ScreenUpdating = False
ActiveSheet.Unprotect 密碼:=PswStr

ActiveSheet.ListObjects("Table1").ListRows.Add

ActiveSheet.Protect 密碼:=PswStr
Application.ScreenUpdating = True

END SUB

這裡還沒有評論

留下你的意見

以訪客身份發帖

登入

名稱（必填）

電子郵件（必填）

評價此帖子：

重設

0 字符

我同意附帶條約