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

Excelで複数のワークシートのドロップダウンリストを同期する方法は?

まったく同じドロップダウン項目を含むワークブックの複数のワークシートにドロップダウン リストがあるとします。 ここで、ワークシート間でドロップダウン リストを同期して、XNUMX つのワークシートのドロップダウン リストから項目を選択すると、他のワークシートのドロップダウン リストが自動的に同じ選択内容に同期されるようにします。 この記事では、この問題の解決に役立つ VBA コードを提供します。

複数のワークシートのドロップダウン リストを VBA コードと同期する


複数のワークシートのドロップダウン リストを VBA コードと同期する

たとえば、ドロップダウン リストは、次の名前の XNUMX つのワークシートにあります。 シート1、シート2、 ···、 シート5、 Sheet1 のドロップダウン選択に従って他のワークシートのドロップダウン リストを同期するには、次の VBA コードを適用してください。

1. Sheet1 を開き、シート タブを右クリックして選択します。 コードを表示 右クリックメニューから選択します。

2。 の中に アプリケーション向け Microsoft Visual Basic ウィンドウで、次の 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、シート 4 及び Sheet5 Sheet1 のドロップダウン リストに基づいて同期するドロップダウン リストを含むワークシートです。
3) コードにさらにワークシートを追加するには、次の XNUMX 行を「application.enablevents = true」、次にシート名を変更します「Sheet5」を必要な名前に変更します。
tSheet1 = ActiveWorkbook.Worksheets("Sheet5") を設定します
tSheet1.Range(xRangeStr).Value = Target.Value

3。 プレス 他の + Q を閉じるためのキー アプリケーション向け Microsoft Visual Basic 窓。

これ以降、ドロップダウン リストからアイテムを選択すると、 シート1、 指定したワークシートのドロップダウン リストが自動的に同期され、同じ選択が行われます。 以下のデモを参照してください。


デモ: Excel で複数のワークシートのドロップダウン リストを同期する


最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80%向上させます

  • 再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。 セルを暗号化する パスワード付き。 メーリングリストを作成する そしてメールを送る...
  • スーパーフォーミュラバー (複数行のテキストと数式を簡単に編集できます); 読書レイアウト (多数のセルを簡単に読み取って編集する); フィルター範囲に貼り付け...
  • セル/行/列をマージする データを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。 範囲を比較する...
  • [複製]または[一意]を選択します 行; 空白行を選択 (すべてのセルは空です); スーパーファインドとファジーファインド 多くのワークブックで; ランダム選択...
  • 正確なコピー 数式参照を変更せずに複数のセル。 参照の自動作成 複数のシートに; 箇条書きを挿入、チェックボックスなど...
  • テキストを抽出、テキストの追加、位置による削除、 スペースを削除する; ページング小計の作成と印刷。 セルの内容とコメントを変換する...
  • スーパーフィルター (フィルタースキームを保存して他のシートに適用します); 高度な並べ替え 月/週/日、頻度など。 特殊フィルター 太字、斜体...
  • ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。 データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
  • 300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。 企業や組織に簡単に導入できます。 フル機能の 30 日間無料トライアル。 60日間の返金保証。
kteタブ201905

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
officetab下部
コメントを並べ替える
コメント (5)
まだ評価はありません。 最初に評価してください!
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、

ドロップダウンが異なる範囲にある場合、どうすればこれを行うことができますか? 詳しく説明すると、セル B7 にあるシート 7 に 6 つのドロップダウンがあり、セル B2 のシート XNUMX に同じドロップダウンがあります。

ありがとうございました、
エレイン
このコメントは、サイトのモデレーターによって最小化されました
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 の内容を B6 ではなくシート 7 の B7 のシート 8 に配置してしまいます。


プライベートサブワークシート_Change(ByValターゲットを範囲として)
'によって更新されました Extendoffice 20221025
Dim tSheet1 をワークシートとして
Dim tRange1 As Range
Dim tRange2 As Range
Dim xRangeStr1 を文字列として
Dim xRangeStr2 を文字列として
エラーで次の再開
Target.Count> 1の場合、Subを終了します

xRangeStr1 = "B2"
xRangeStr2 = "B3"

tRange1 = Range("B7") を設定します。
tRange1 が何もない場合
xRangeStr1 = tRange1.Address
Application.EnableEvents = False
tSheet1 = ActiveWorkbook.Worksheets("Sheet7") を設定します
tSheet1.Range(xRangeStr1).Value = Target.Value
application.enablevents = true
終了する場合

tRange2 = Range("B8") を設定します。
tRange2 が何もない場合
xRangeStr2 = tRange2.Address
Application.EnableEvents = False
tSheet1 = ActiveWorkbook.Worksheets("Sheet7") を設定します
tSheet1.Range(xRangeStr2).Value = Target.Value
application.enablevents = true
終了する場合

End Subの
ここにはまだコメントが投稿されていません
あなたのコメントを残す
ゲストとして投稿
×
この投稿を評価:
0   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護