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

Excel'de birden çok çalışma sayfasındaki açılır listeler nasıl senkronize edilir?

Tam olarak aynı açılır öğeleri içeren bir çalışma kitabındaki birkaç çalışma sayfasında açılan listeleriniz olduğunu varsayalım. Şimdi, bir çalışma sayfasındaki açılır listeden bir öğe seçtiğinizde, diğer çalışma sayfalarındaki açılır listeler aynı seçimle otomatik olarak eşitlenecek şekilde, çalışma sayfaları arasında açılır listeleri senkronize etmek istiyorsunuz. Bu makale, bu sorunu çözmenize yardımcı olacak bir VBA kodu sağlar.

Birden çok çalışma sayfasındaki açılır listeleri VBA koduyla senkronize edin


Birden çok çalışma sayfasındaki açılır listeleri VBA koduyla senkronize edin

Örneğin, açılır listeler şu adlarla adlandırılan beş çalışma sayfasındadır: Sayfa1, Sayfa2, ..., Sayfa5, Sayfa1'deki açılır seçime göre diğer çalışma sayfalarındaki açılır listeleri senkronize etmek için lütfen aşağıdaki VBA kodunu uygulayarak bunu yapın.

1. Sayfa1'i açın, sayfa sekmesine sağ tıklayın ve Kodu Görüntüle sağ tıklama menüsünden.

2. içinde Uygulamalar için Microsoft Visual Basic penceresinde aşağıdaki VBA kodunu yapıştırın. Sayfa1 (Kod) pencere.

VBA kodu: Birden çok çalışma sayfasındaki açılır listeyi senkronize edin

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

Notlar:

1) Kodda, A2: A11 açılır listeyi içeren aralıktır. Tüm açılır listelerin farklı çalışma sayfalarında aynı aralıkta olduğundan emin olun.
2) Sayfa2, Sayfa3, Sayfa4 ve Sheet5 Sayfa1'deki açılır listeye göre senkronize etmek istediğiniz açılır listeleri içeren çalışma sayfalarıdır;
3) Kodda daha fazla çalışma sayfası eklemek için lütfen aşağıdaki iki satırı “ satırından önce ekleyin.Application.EnableEvents = True”, ardından sayfa adını değiştirin”Sheet5"İhtiyacınız olan isme.
tSheet1 = ActiveWorkbook.Worksheets("Sayfa5") olarak ayarlayın
tSheet1.Range(xRangeStr).Value = Target.Value

3. Tuşuna basın. Ara Toplam + Q kapatmak için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.

Şu andan itibaren, içindeki açılır listeden bir öğe seçtiğinizde Sayfa1, belirtilen çalışma sayfalarındaki açılır listeler, aynı seçime sahip olacak şekilde otomatik olarak senkronize edilecektir. Aşağıdaki demoya bakın.


Demo: Excel'de Birden Çok Çalışma Sayfasındaki Açılır Listeleri Senkronize Etme


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (5)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Açılır listelerim farklı aralıklardaysa bunu nasıl yapabilirim? Ayrıntılı olarak, B7 hücresinde bulunan 7. sayfada bir açılır listem ve B6 hücresindeki 2. sayfada aynı açılır listem var.

Teşekkür ederim,
Elaine
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba E
Aşağıdaki VBA kodu yardımcı olabilir.
Burada Sayfa6'yı ana çalışma sayfası olarak alıyorum, sayfa sekmesine sağ tıklayın, sağ tıklama menüsünden Kodu Görüntüle'yi seçin, ardından aşağıdaki kodu Sayfa6 (Kod) penceresine kopyalayın. Sayfa2'nın B6'sindeki açılır listeden herhangi bir öğeyi seçtiğinizde, Sayfa7'nin B7'sindeki açılır liste aynı seçili öğeye sahip olacak şekilde senkronize edilecektir.

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
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Cevabınız için çok teşekkür ederim, kodunuz çalıştı! Aynı işleve sahip olması gereken sırasıyla b2 ve b7, b3 ve b8'in hemen altında bir hücrem var. Aşağıda gösterildiği gibi kodunuzu yeniden yazmaya çalıştım, ancak bu işe yaramadı. b7'ü değiştirdiğimde b8 yerine b3'nin değişmesine neden oldu. Neyi yanlış yaptığımı belirleyebilir misin?

Çok teşekkür ederim!

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
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba E
Yukarıda size yanıtladığım VBA kodunda bir sorun var.
Bahsettiğiniz yeni soru için lütfen aşağıdaki kodu deneyin.

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
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kristal,

Cevabınız için çok teşekkür ederim, bu işe yaradı! Aynı sayfa 6, B3'e, ayrıca sayfa 8'deki B7 ile senkronize edilmesi gereken başka bir hücre eklemek için kodu nasıl değiştirebilirim? Aşağıda değiştirmeye çalıştım, ancak B3'ün içeriğini B6 yerine B7'deki sayfa 7'ya, sayfa 8'ye koyuyor.


Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
'Tarafından güncellendi Extendoffice 20221025
Çalışma Sayfası Olarak Dim tSheet1
Aralık Olarak Dim tRange1
Aralık Olarak Dim tRange2
Dize Olarak Dim xRangeStr1
Dize Olarak Dim xRangeStr2
On Error Resume Next
Target.Count > 1 ise Sub Exit

xRangeStr1 = "B2"
xRangeStr2 = "B3"

tRange1 = Range("B7") olarak ayarlayın
tRange1 Değilse O Zaman Hiçbir Şey Değilse
xRangeStr1 = tRange1.Adres
Application.EnableEvents = Yanlış
tSheet1 = ActiveWorkbook.Worksheets("Sayfa7") olarak ayarlayın
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = True
Eğer son

tRange2 = Range("B8") olarak ayarlayın
tRange2 Değilse O Zaman Hiçbir Şey Değilse
xRangeStr2 = tRange2.Adres
Application.EnableEvents = Yanlış
tSheet1 = ActiveWorkbook.Worksheets("Sayfa7") olarak ayarlayın
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = True
Eğer son

End Sub
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır