Note: The other languages of the website are Google-translated. Back to English

如何在 Excel 中同步多個工作表中的下拉列表?

假設您在工作簿中的多個工作表上有下拉列表,其中包含完全相同的下拉項。 現在,您希望跨工作表同步下拉列表,這樣一旦您從一個工作表的下拉列表中選擇了一個項目,其他工作表中的下拉列表就會自動同步相同的選擇。 本文提供了一個 VBA 代碼來幫助您解決這個問題。

使用 VBA 代碼同步多個工作表中的下拉列表


使用 VBA 代碼同步多個工作表中的下拉列表

例如,下拉列表位於五個名為 工作表 1、工作表 2、 ... 表 5, 要根據Sheet1中的下拉選擇同步其他工作表中的下拉列表,請應用以下VBA代碼完成。

1.打開Sheet1,右鍵單擊工作表選項卡並選擇 查看代碼 從右鍵單擊菜單。

2。 在裡面 Microsoft Visual Basic for Applications 窗口,將以下 VBA 代碼粘貼到 Sheet1(代碼) 窗口。

VBA代碼:同步多個工作表中的下拉列表

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220815
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "A2:A11"

    Set tRange = Intersect(Target, Range(xRangeStr))
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet2")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet3")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet4")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

筆記:

1)在代碼中, A2:A11 是包含下拉列表的範圍。 確保所有下拉列表在不同工作表中的範圍相同。
2) 表 2、表 3、表 4Sheet5 是包含要根據 Sheet1 中的下拉列表同步的下拉列表的工作表;
3)要在代碼中添加更多工作表,請在“行”之前添加以下兩行Application.EnableEvents = True”,然後更改工作表名稱“Sheet5”到您需要的名稱。
設置 tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
tSheet1.Range(xRangeStr).Value = Target.Value 值

3。 按 其他 + Q 關閉鍵 Microsoft Visual Basic for Applications 窗口。

從現在開始,當您從下拉列表中選擇一個項目時 表 1, 指定工作表中的下拉列表將自動同步以具有相同的選擇。 請參閱下面的演示。


演示:在 Excel 中同步多個工作表中的下拉列表


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (5)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
嗨,

如果我的下拉菜單在不同的範圍內,我該怎麼做? 詳細地說,我在單元格 B7 中的工作表 7 中有一個下拉菜單,在單元格 B6 的工作表 2 上有相同的下拉菜單。

謝謝你,
伊萊恩
網站主持人對此評論進行了最小化
嗨,E,
以下 VBA 代碼可以提供幫助。
這裡我以Sheet6為主工作表,右鍵工作表標籤,在右鍵菜單中選擇查看代碼,然後在Sheet6(代碼)窗口中復制如下代碼。 當您從 Sheet2 的 B6 中的下拉列表中選擇任何項目時,Sheet7 的 B7 中的下拉列表將同步為具有相同的選定項。

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "B2"
    
    Set tRange = Range("B7")
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub
網站主持人對此評論進行了最小化
嗨水晶,

非常感謝您的回复,您的代碼有效! 我分別在 b2 和 b7、b3 和 b8 下方有一個單元格,它們需要具有相同的功能。 我試圖重寫您的代碼,如下所示,但這不起作用。 當我更改 b7 時,它導致 b8 而不是 b3 更改。 你能確定我做錯了什麼嗎?

太感謝你了!

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange1 As Range
    Dime tRange2 As Range
    Dim xRangeStr1 As String
    Dim xRangeStr2 As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr1 = "B2"
    xRangeStr2="B3"
    
    Set tRange1 = Range("B7")
    If Not tRange1 Is Nothing Then
        xRangeStr1 = tRange1.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr1).Value = Target.Value
        Application.EnableEvents = True
    End If
    
    Set tRange2 = Range("B8")
    If Not tRange2 Is Nothing Then
        xRangeStr2 = tRange2.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr2).Value = Target.Value
        Application.EnableEvents = True
    End If

End Sub
網站主持人對此評論進行了最小化
嗨,E,
我在上面回复你的 VBA 代碼有問題。
對於您提到的新問題,請嘗試以下代碼。

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221031
    
    Dim xBool1 As Boolean
    Dim xBool2 As Boolean
    Dim xRgStr As String
    Dim tRange As Range
    
    xRangeStr1 = "B2"
    xRangeStr2 = "B3"
    xRgStr = ""
    
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    xBool1 = Intersect(Target, Range(xRangeStr1)) Is Nothing
    xBool2 = Intersect(Target, Range(xRangeStr2)) Is Nothing
    
    If xBool1 And xBool2 Then Exit Sub
    
    xRgStr = Target.Address(False, False, xlA1, False, False)
    
    If Target.Address(False, False, xlA1, False, False) = xRangeStr1 Then
        xRgStr = "b7"
    ElseIf Target.Address(False, False, xlA1, False, False) = xRangeStr2 Then
        xRgStr = "b8"
    End If
    If xRgStr = "" Then Exit Sub
    
    Application.EnableEvents = False
    Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
    tSheet1.Range(xRgStr).Value = Target.Value
    Application.EnableEvents = True

End Sub
網站主持人對此評論進行了最小化
水晶,

非常感謝您的回复,這有效! 如何修改代碼以在同一張表 6 中添加另一個單元格,B3 也需要與表 8 中的 B7 同步? 我試圖在下面對其進行修改,但最終將 B3 的內容放在第 6 頁的 B7 的第 7 頁而不是 B8 上。


Private Sub Worksheet_Change(ByVal Target As Range)
'更新者 Extendoffice 20221025
將 tSheet1 調暗為工作表
將 tRange1 調暗為範圍
將 tRange2 調暗為範圍
將 xRangeStr1 調暗為字符串
將 xRangeStr2 調暗為字符串
在錯誤恢復下一頁
如果 Target.Count > 1 則退出 Sub

xRangeStr1 = "B2"
xRangeStr2 = "B3"

設置 tRange1 = Range("B7")
If Not tRange1 is nothing 那麼
xRangeStr1 = tRange1.地址
Application.EnableEvents = False
設置 tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Value = Target.Value 值
Application.EnableEvents = True
如果結束

設置 tRange2 = Range("B8")
If Not tRange2 is nothing 那麼
xRangeStr2 = tRange2.地址
Application.EnableEvents = False
設置 tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Value = Target.Value 值
Application.EnableEvents = True
如果結束

END SUB
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護