Sut i gysoni cwymplenni mewn taflenni gwaith lluosog yn Excel?

Tybiwch fod gennych chi gwymplenni ar sawl taflen waith mewn llyfr gwaith sy'n cynnwys yr un eitemau cwymplen yn union. Nawr rydych chi am gydamseru'r cwymplenni ar draws taflenni gwaith fel bod y rhestrau cwympo mewn taflenni gwaith eraill yn cael eu cydamseru'n awtomatig ar ôl i chi ddewis eitem o gwymplen mewn un daflen waith. Mae'r erthygl hon yn darparu cod VBA i'ch helpu i ddatrys y broblem hon.

Cydamseru cwymplenni mewn taflenni gwaith lluosog gyda chod VBA

Cydamseru cwymplenni mewn taflenni gwaith lluosog gyda chod VBA

Er enghraifft, mae'r cwymplenni mewn pum taflen waith a enwir dalen 1, dalen 2, ..., Taflen 5, i gydamseru'r cwymplenni mewn taflenni gwaith eraill yn ôl y cwymplen yn Nhaflen 1, cymhwyswch y cod VBA canlynol i'w wneud.

1. Agorwch Sheet1, de-gliciwch ar y tab taflen a dewiswch Gweld y Cod o'r ddewislen cywir ar y dde.

2. Yn y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, gludwch y cod VBA canlynol i mewn i'r Dalen 1 (Cod) ffenestr.

Cod VBA: Cydamseru'r gwymplen mewn taflenni gwaith lluosog

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

Nodiadau:

1) Yn y cod, A2: A11 yw'r ystod sy'n cynnwys y gwymplen. Sicrhewch fod yr holl gwymplenni yn yr un ystod ar draws gwahanol daflenni gwaith.

2) Taflen2, Taflen3, Taflen4 ac Sheet5 yn daflenni gwaith sy'n cynnwys cwymplenni rydych am eu cysoni yn seiliedig ar y gwymplen yn Nhaflen 1;

3) I ychwanegu mwy o daflenni gwaith yn y cod, ychwanegwch y ddwy linell ganlynol cyn y llinell “Application.EnableEvents = Gwir”, yna newidiwch enw'r ddalen “Sheet5” i'r enw sydd ei angen arnoch chi.

Gosod tSheet1 = ActiveWorkbook.Worksheets("Taflen5")

tSheet1.Range(xRangeStr).Value = Targed.Gwerth

3. Gwasgwch y Alt + Q allweddi i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

O hyn ymlaen, pan fyddwch chi'n dewis eitem o'r gwymplen i mewn Taflen 1, bydd y cwymplenni yn y taflenni gwaith penodedig yn cael eu cysoni'n awtomatig i gael yr un dewis. Gweler y demo isod.

Demo: Cydamseru Rhestrau Gollwng Mewn Taflenni Gwaith Lluosog Yn Excel

Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
Mwy na 300 o nodweddion pwerus. Yn cefnogi Office / Excel 2007-2021 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.

Read More ... Lawrlwythiad Am Ddim... Prynu ...

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a Gwneud Eich Gwaith yn Haws o lawer

Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!

Read More ... Lawrlwythiad Am Ddim... Prynu ...

sylwadau (5)

Dim sgôr eto. Byddwch y cyntaf i sgorio!

tua 3 mis yn ôl

#40764

Lleihawyd y sylw hwn gan y safonwr ar y wefan

Heia,

Sut alla i wneud hyn os yw fy nghwympiadau mewn ystodau gwahanol? I ymhelaethu, mae gennyf un cwymplen yn nhaflen 7 sydd yng nghell B7 a'r un cwymplen ar ddalen 6 yng nghell B2.

Diolch yn fawr,
Elaine

ateb

grisial E

tua 3 mis yn ôl

#40859

Lleihawyd y sylw hwn gan y safonwr ar y wefan

Helo E,
Gall y cod VBA canlynol helpu.
Yma rwy'n cymryd Sheet6 fel y brif daflen waith, cliciwch ar y dde ar y tab taflen, dewiswch Gweld Cod o'r ddewislen clicio ar y dde, yna copïwch y cod canlynol yn y ffenestr Sheet6 (Code). Pan fyddwch chi'n dewis unrhyw eitem o'r gwymplen yn B2 o Daflen6, bydd y gwymplen yn B7 o Daflen7 yn cael ei chynamseru i gael yr un eitem ddethol.

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

ateb

adroddiad

E grisial

tua 3 mis yn ôl

#40915

Lleihawyd y sylw hwn gan y safonwr ar y wefan

Helo Crystal,

Diolch yn fawr iawn am eich ymateb, fe weithiodd eich cod! Mae gen i gell o dan b2 a b7, b3 a b8 yn y drefn honno sydd angen yr un swyddogaeth. Ceisiais ailysgrifennu'ch cod fel y dangosir isod, ond ni weithiodd hyn. Achosodd i b7 yn lle b8 newid pan newidiais b3. A allech chi nodi'r hyn yr wyf yn ei wneud o'i le?

Diolch yn fawr!

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

ateb

grisial E

tua 2 mis yn ôl

#40991

Lleihawyd y sylw hwn gan y safonwr ar y wefan

Helo E,
Mae rhywbeth o'i le ar y cod VBA a atebais i chi uchod.
Ar gyfer y cwestiwn newydd a grybwyllwyd gennych, rhowch gynnig ar y cod canlynol.

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

ateb

adroddiad

tua 3 mis yn ôl

#40890

Lleihawyd y sylw hwn gan y safonwr ar y wefan

Grisial,

Diolch yn fawr iawn am eich ymateb, fe weithiodd hyn! Sut allwn i addasu'r cod i ychwanegu cell arall yn yr un ddalen 6, B3 yr oedd angen ei chydamseru â B8 yn nhaflen 7 hefyd? Rwyf wedi ceisio ei addasu isod, ond yn y diwedd mae'n rhoi cynnwys B3 ar ddalen 6 yn B7 ar ddalen 7 yn lle B8.

Is-daflen Waith Breifat_Newid(Targed ByVal Fel Ystod)
'Diweddarwyd gan Extendoffice 20221025
Dim t Sheet1 Fel Taflen Waith
Dim trange1 As Range
Dim trange2 As Range
Dim xRangeStr1 Fel Llinyn
Dim xRangeStr2 Fel Llinyn
Ar Ail-ddechrau Gwall Nesaf
Os Targed.Cyfrif > 1 Yna Gadael Is

xRangeStr1 = "B2"
xRangeStr2 = "B3"

Gosod tRange1 = Ystod ("B7")
Os Nad yw trange1 Yn Dim Yna
xRangeStr1 = tRange1.Address
Application.EnableEvents = Gau
Gosod tSheet1 = ActiveWorkbook.Worksheets("Taflen7")
tSheet1.Range(xRangeStr1).Gwerth = Targed.Gwerth
Application.EnableEvents = Gwir
Gorffennwch Os

Gosod tRange2 = Ystod ("B8")
Os Nad yw trange2 Yn Dim Yna
xRangeStr2 = tRange2.Address
Application.EnableEvents = Gau
Gosod tSheet1 = ActiveWorkbook.Worksheets("Taflen7")
tSheet1.Range(xRangeStr2).Gwerth = Targed.Gwerth
Application.EnableEvents = Gwir
Gorffennwch Os

Is-End

ateb

Nid oes unrhyw sylwadau wedi'u postio yma eto

Gadewch eich sylwadau

Postio fel Gwestai

Mewngofnodi

Enw (Angenrheidiol)

E-bost (Angenrheidiol)

Graddiwch y swydd hon:

Ailosod

0 Cymeriadau

Cytunaf â'r telerau a chyflwr