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

Cum se sincronizează listele derulante în mai multe foi de lucru în Excel?

Să presupunem că aveți liste derulante pe mai multe foi de lucru dintr-un registru de lucru care conțin exact aceleași elemente derulante. Acum doriți să sincronizați listele derulante între foile de lucru, astfel încât, odată ce selectați un element dintr-o listă derulantă dintr-o foaie de lucru, listele derulante din alte foi de lucru să fie sincronizate automat cu aceeași selecție. Acest articol oferă un cod VBA pentru a vă ajuta să rezolvați această problemă.

Sincronizați listele derulante în mai multe foi de lucru cu cod VBA


Sincronizați listele derulante în mai multe foi de lucru cu cod VBA

De exemplu, listele derulante sunt în cinci foi de lucru numite Sheet1, Sheet2, ..., Foaia 5, pentru a sincroniza listele drop-down din alte foi de lucru în funcție de selecția drop-down din Sheet1, vă rugăm să aplicați următorul cod VBA pentru a finaliza.

1. Deschideți Sheet1, faceți clic dreapta pe fila foii și selectați Afișați codul din meniul cu clic dreapta.

2. În Microsoft Visual Basic pentru aplicații fereastră, inserați următorul cod VBA în Sheet1 (Cod) fereastră.

Cod VBA: Sincronizați lista derulantă în mai multe foi de lucru

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

note:

1) În cod, A2: A11 este intervalul care conține lista derulantă. Asigurați-vă că toate listele derulante sunt în același interval în diferite foi de lucru.
2) Sheet2, Sheet3, Sheet4 și Sheet5 sunt foi de lucru care conțin liste drop-down pe care doriți să le sincronizați pe baza listei drop-down din Sheet1;
3) Pentru a adăuga mai multe foi de lucru în cod, adăugați următoarele două rânduri înainte de linia „Application.EnableEvents = Adevărat”, apoi schimbați numele foii „Sheet5” la numele de care aveți nevoie.
Setați tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
tSheet1.Range(xRangeStr).Value = Target.Value

3. apasă pe Alt + Q tastele pentru a închide Microsoft Visual Basic pentru aplicații fereastră.

De acum înainte, când selectați un articol din lista derulantă în Foaia 1, listele derulante din foile de lucru specificate vor fi sincronizate automat pentru a avea aceeași selecție. Vezi demonstrația de mai jos.


Demo: Sincronizați listele drop-down în mai multe foi de lucru în Excel


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (5)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Cum pot face acest lucru dacă meniurile mele derulante sunt în intervale diferite? Pentru a detalia, am un drop-down în foaia 7 care se află în celula B7 și același drop-down pe foaia 6 în celula B2.

Mulțumesc,
Elaine
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut E,
Următorul cod VBA vă poate ajuta.
Aici iau Sheet6 ca foaie de lucru principală, faceți clic dreapta pe fila foii, selectați View Code din meniul clic dreapta, apoi copiați următorul cod în fereastra Sheet6 (Code). Când selectați orice articol din lista derulantă din B2 din Sheet6, lista drop-down din B7 din Sheet7 va fi sincronizată pentru a avea același articol selectat.

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
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,

Vă mulțumesc foarte mult pentru răspuns, codul dvs. a funcționat! Am o celulă chiar sub b2 și b7, b3 și respectiv b8 care trebuie să aibă aceeași funcție. Am încercat să vă rescriu codul așa cum se arată mai jos, dar acest lucru nu a funcționat. A făcut ca b7 în loc de b8 să se schimbe când am schimbat b3. Ai putea să identifici ce greșesc?

Va multumesc foarte mult!

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
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut E,
Este ceva în neregulă cu codul VBA la care ți-am răspuns mai sus.
Pentru noua întrebare pe care ați menționat-o, vă rugăm să încercați următorul cod.

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
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cristal,

Mulțumesc mult pentru răspuns, a funcționat! Cum aș putea modifica codul pentru a adăuga o altă celulă în aceeași foaie 6, B3 care trebuia, de asemenea, sincronizată cu B8 în foaia 7? Am încercat să-l modific mai jos, totuși ajunge să pună conținutul B3 pe foaia 6 în B7 pe foaia 7 în loc de B8.


Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
„Actualizat de Extendoffice 20221025
Dim tSheet1 ca foaie de lucru
Dim tRange1 As Range
Dim tRange2 As Range
Dim xRangeStr1 ca șir
Dim xRangeStr2 ca șir
La data de eroare CV următoare
Dacă Target.Count > 1, apoi Ieșiți din sub

xRangeStr1 = „B2”
xRangeStr2 = „B3”

Set tRange1 = Range("B7")
Dacă nu tRange1 este nimic, atunci
xRangeStr1 = tRange1.Address
Application.EnableEvents = Fals
Setați tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = Adevărat
Final, dacă

Set tRange2 = Range("B8")
Dacă nu tRange2 este nimic, atunci
xRangeStr2 = tRange2.Address
Application.EnableEvents = Fals
Setați tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = Adevărat
Final, dacă

End Sub
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL