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 հավելվածների համար պատուհանում տեղադրեք հետևյալ VBA կոդը Թերթ 1 (կոդ) պատուհան.

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) Sheet2, Sheet3, Sheet4 և Sheet5 աշխատաթերթեր են, որոնք պարունակում են բացվող ցուցակներ, որոնք ցանկանում եք համաժամացնել Sheet1-ի բացվող ցուցակի հիման վրա.
3) Կոդում ավելի շատ աշխատաթերթեր ավելացնելու համար խնդրում ենք ավելացնել հետևյալ երկու տողերը տողից առաջ «Application.EnableEvents = Ճիշտ է», այնուհետև փոխեք թերթի անունը»Sheet5«Ձեզ անհրաժեշտ անվանը:
Սահմանել tSheet1 = ActiveWorkbook.Worksheets («Sheet5»)
tSheet1.Range(xRangeStr).Value = Target.Value

3. Սեղմեք ալտ + Q ստեղները փակելու համար Microsoft Visual Basic հավելվածների համար պատուհան.

Այսուհետ, երբ դուք ընտրում եք որևէ տարր բացվող ցանկից Թերթ 1, նշված աշխատաթերթերում բացվող ցուցակները ավտոմատ կերպով կհամաժամացվեն՝ նույն ընտրությունն ունենալու համար: Տես ստորև ներկայացված ցուցադրությունը:

Դեմո. համաժամացրեք բացվող ցուցակները Excel-ում բազմաթիվ աշխատաթերթերում

Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
Հները `սկզբում
Նորերը `սկզբում
մեկնաբանություններ (5)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
E
E
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,

Ինչպե՞ս կարող եմ դա անել, եթե իմ բացվող ցանկերը տարբեր տիրույթներում են: Մանրամասնելու համար, ես ունեմ մեկ կաթիլ 7-րդ թերթիկում, որը գտնվում է B7 բջիջում և նույն անկումը 6-րդ թերթիկի վրա՝ B2 բջիջում:

Thank you,
Elaine
պատասխանել
0
0
բյուրեղապակի
բյուրեղապակի     E
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև E,
Հետևյալ VBA կոդը կարող է օգնել.
Այստեղ ես վերցնում եմ Sheet6-ը որպես հիմնական աշխատաթերթ, աջ սեղմում եմ թերթի ներդիրի վրա, ընտրում եմ Դիտել կոդը աջ սեղմման ընտրացանկից, այնուհետև պատճենում եմ հետևյալ կոդը Sheet6 (Code) պատուհանում: Երբ ընտրեք որևէ տարր 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
պատասխանել
հաշվետվություն
0
0
E
E     բյուրեղապակի
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ,

Շատ շնորհակալ եմ ձեր արձագանքի համար, ձեր կոդը աշխատեց: Ես համապատասխանաբար 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
պատասխանել
0
0
բյուրեղապակի
բյուրեղապակի     E
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև 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
պատասխանել
հաշվետվություն
0
0
E
E
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բյուրեղյա,

Շատ շնորհակալ եմ ձեր արձագանքի համար, սա ստացվեց: Ինչպե՞ս կարող եմ փոփոխել կոդը՝ ավելացնելու մեկ այլ բջիջ նույն 6-րդ թերթում, B3, որը նույնպես պետք է համաժամացվեր B8-ի հետ 7-րդ թերթում: Ես փորձել եմ այն ​​փոփոխել ստորև, սակայն այն ավարտվում է B3-ի փոխարեն B6-ի բովանդակությունը 7-րդ թերթիկում B7-ում՝ 8-ի վրա:


Private Sub Worksheet_Change (ByVal Target as Range)
«Թարմացվել է Extendoffice 20221025
Dim tSheet1 որպես աշխատանքային թերթիկ
Dim tRange1 որպես միջակայք
Dim tRange2 որպես միջակայք
Dim xRangeStr1 որպես տող
Dim xRangeStr2 որպես տող
Ս.թ. սխալի Ռեզյումե Next
Եթե ​​Target.Count > 1 Ապա Ելք Ենթ

xRangeStr1 = «B2»
xRangeStr2 = «B3»

Սահմանել tRange1 = Range («B7»)
Եթե ​​ոչ tRange1-ը ոչինչ է, ապա
xRangeStr1 = tRange1.Հասցե
Application.EnableEvents = False
Սահմանել tSheet1 = ActiveWorkbook.Worksheets («Sheet7»)
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = Ճիշտ է
Վերջ: Եթե

Սահմանել tRange2 = Range («B8»)
Եթե ​​ոչ tRange2-ը ոչինչ է, ապա
xRangeStr2 = tRange2.Հասցե
Application.EnableEvents = False
Սահմանել tSheet1 = ActiveWorkbook.Worksheets («Sheet7»)
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = Ճիշտ է
Վերջ: Եթե

Վերջ Sub
պատասխանել
0
0
Առայժմ ոչ մի մեկնաբանություն չկա
Թողեք ձեր մեկնաբանությունները
Հյուր
Հրապարակում որպես հյուր
Մուտք
×
Գնահատեք այս գրառումը.
Նորից դնել
0   Անձնավորություններ
Առաջարկվող վայրեր

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից