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日間の返金保証。

続きを読みます... 無料ダウンロード... 購入...

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

Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
生産性を 50% 向上させ、毎日何百回もマウスクリックを減らすことができます!

続きを読みます... 無料ダウンロード... 購入...

コメント (5)

まだ評価はありません。最初に評価してください！

約3ヶ月前

#40764

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、

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

ありがとうございました、
エレイン

返信

結晶 E

約3ヶ月前

#40859

このコメントは、サイトのモデレーターによって最小化されました

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

返信

レポート

E 結晶

約3ヶ月前

#40915

このコメントは、サイトのモデレーターによって最小化されました

こんにちはクリスタル、

ご回答ありがとうございます。コードが機能しました。 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

約2ヶ月前

#40991

このコメントは、サイトのモデレーターによって最小化されました

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

返信

レポート

約3ヶ月前

#40890

このコメントは、サイトのモデレーターによって最小化されました

結晶、

ご回答ありがとうございます。これでうまくいきました。シート 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 文字

同意します利用規約と条件