Hogyan lehet szinkronizálni a legördülő listákat több munkalapon az Excelben?

Tegyük fel, hogy egy munkafüzet több munkalapján is vannak legördülő listák, amelyek pontosan ugyanazokat a legördülő elemeket tartalmazzák. Most szinkronizálni szeretné a legördülő listákat a munkalapok között, így ha egyszer kiválasztott egy elemet az egyik munkalap legördülő listájából, a többi munkalap legördülő listái is automatikusan szinkronizálódnak ugyanazzal a kijelöléssel. Ez a cikk egy VBA-kódot tartalmaz a probléma megoldásához.

Szinkronizálja a legördülő listákat több munkalapon VBA-kóddal

Szinkronizálja a legördülő listákat több munkalapon VBA-kóddal

Például a legördülő listák öt elnevezésű munkalapon találhatók Lap1, Lap2, ..., A lemorzsolódási Window 5. lap, a többi munkalap legördülő listáinak szinkronizálásához az 1. munkalap legördülő menüjében, kérjük, alkalmazza a következő VBA-kódot a végrehajtáshoz.

1. Nyissa meg a Sheet1 alkalmazást, kattintson a jobb gombbal a lapfülre, és válassza ki Kód megtekintése a jobb egérgombbal.

2. Ban,-ben Microsoft Visual Basic for Applications ablakban illessze be a következő VBA-kódot a 1. munkalap (kód) ablak.

VBA-kód: Szinkronizálja a legördülő listát több munkalapon

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

Megjegyzések:

1) A kódban A2: A11 a legördülő listát tartalmazó tartomány. Győződjön meg arról, hogy az összes legördülő lista ugyanabban a tartományban van a különböző munkalapokon.

2) Lap2, Lap3, Lap4 és a Sheet5 olyan munkalapok, amelyek az 1. munkalap legördülő listája alapján szinkronizálni kívánt legördülő listákat tartalmaznak;

3) Ha további munkalapokat szeretne hozzáadni a kódhoz, kérjük, adja hozzá a következő két sort a következő sor eléApplication.EnableEvents = Igaz", majd módosítsa a lap nevét "Sheet5” a kívánt névre.

Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")

tSheet1.Range(xRangeStr).Value = Target.Value

3. megnyomni a más + Q gombok a Microsoft Visual Basic for Applications ablak.

Mostantól, amikor kiválaszt egy elemet a legördülő listából 1. lap, a megadott munkalapokon lévő legördülő listák automatikusan szinkronizálva lesznek, hogy ugyanazt a kijelölést tartalmazza. Lásd az alábbi bemutatót.

Demo: Legördülő listák szinkronizálása több munkalapon az Excelben

A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.

Tovább ... Ingyenes letöltés... Vásárlás...

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!

Tovább ... Ingyenes letöltés... Vásárlás...

Hozzászólások (5)

Még nincs értékelés. Legyen Ön az első, aki értékel!

mintegy 3 hónappal ezelőtt

#40764

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia,

Hogyan tehetem ezt meg, ha a legördülő menük különböző tartományban vannak? A részletezéshez a 7. lapon van egy legördülő menü, amely a B7 cellában található, és ugyanaz a legördülő menü a 6. lapon a B2 cellában.

Köszönöm,
Elaine

Válasz

kristály- E

mintegy 3 hónappal ezelőtt

#40859

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia E,
A következő VBA kód segíthet.
Itt a Sheet6-ot veszem fő munkalapnak, jobb gombbal kattintok a lapfülre, a jobb egérgombos menüből válassza ki a View Code parancsot, majd másolja be a következő kódot a Sheet6 (Code) ablakba. Ha kiválaszt egy elemet a 2. munkalap B6 legördülő listájából, a 7. munkalap B7 legördülő listája szinkronizálva lesz, hogy ugyanazt a kiválasztott elemet tartalmazza.

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

Válasz

Jelentés

E kristály-

mintegy 3 hónappal ezelőtt

#40915

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia Crystal,

Köszönöm szépen a választ, működött a kód! Van egy cellám a b2 és b7, b3 és b8 alatt, amelyeknek ugyanazzal a funkcióval kell rendelkezniük. Megpróbáltam átírni a kódot az alábbiak szerint, de ez nem működött. Ez okozta a b7-et a b8 helyett, amikor megváltoztattam a b3-at. Esetleg be tudod azonosítani, hogy mit csinálok rosszul?

Köszönöm szépen!

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

Válasz

kristály- E

mintegy 2 hónappal ezelőtt

#40991

A weboldal moderátora ezt a megjegyzést minimalizálta

Szia E,
Valami hiba van a VBA kóddal, amit fent válaszoltam.
Az Ön által említett új kérdéshez próbálja meg a következő kódot.

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

Válasz

Jelentés

mintegy 3 hónappal ezelőtt

#40890

A weboldal moderátora ezt a megjegyzést minimalizálta

Kristály,

Köszönöm szépen a választ, sikerült! Hogyan módosíthatnám a kódot, hogy hozzáadjak egy másik cellát ugyanarra a 6. lapra, B3-ra, amelyet szintén szinkronizálni kellett a 8. lap B7-asával? Az alábbiakban megpróbáltam módosítani, de végül a B3 tartalma a 6. lapon, a B7-ben a 7. lapon található B8 helyett.

Private Sub Worksheet_Change (ByVal Target mint Range)
'Frissítette Extendoffice 20221025
Dim tSheet1 munkalapként
Dim tRange1 As Range
Dim tRange2 As Range
Dim xRangeStr1 karakterláncként
Dim xRangeStr2 karakterláncként
On Error Resume Next
Ha Target.Count > 1, akkor lépjen ki a Sub

xRangeStr1 = "B2"
xRangeStr2 = "B3"

tRange1 beállítása = Tartomány("B7")
Ha nem tRange1 semmi akkor
xRangeStr1 = tRange1.Address
Application.EnableEvents = Hamis
Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Érték = Target.Value
Application.EnableEvents = Igaz
Ha véget

tRange2 beállítása = Tartomány("B8")
Ha nem tRange2 semmi akkor
xRangeStr2 = tRange2.Address
Application.EnableEvents = Hamis
Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Érték = Target.Value
Application.EnableEvents = Igaz
Ha véget

End Sub

Válasz

Még senki sem írt megjegyzést

Hagyja meg észrevételeit

Feladás vendégként

Bejelentkezés

Név (kötelező)

Email (szükséges)

Értékeld ezt a bejegyzést:

vissza

0 Karakterek

Egyetértek azzal, hogy a szabályait és feltételeit