Seçime göre İlçe işlerinin getirilmesi

okavut

Altın Üye
Katılım
22 Şubat 2007
Mesajlar
163
Excel Vers. ve Dili
excel 2016 TR
Altın Üyelik Bitiş Tarihi
12-01-2028
Sayın üstatlarımız
Arkadaşlarımızın yardımıyla bir tablo oluşturdum.
Ancak soru sayfasında da görüldüğü üzere benim uğraştığım seçilen ilçeye göre tesislerin getirilmesi.
Saygılarımla.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
SORU sayfasındaki 8. satırdan itibaren olan veri ve formülleri silin (B:H arası)

SORU sayfasında bitiş yılı yani F sütununun biçimini Genel yapın

Aşağıdaki kodları SORU sayfasının kod bölümüne (sayfa adına sağ tıklayıp Kod Görüntüle deyince açılan sayfaya) kopyalayın.

L4 yani ilçeyi değiştirdiğinizde o ilçenin verileri listelenecektir:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [L4]) Is Nothing Then Exit Sub

Set s1 = Sheets("VERİ")
son = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(8, Cells(Rows.Count, "B").End(3).Row)
Range("A5:J" & eski).ClearContents

If WorksheetFunction.CountIf(s1.Range("B4:B" & son), Target) = 0 Then
    MsgBox Target & " ilçesine ait tesis bulunmamaktadır.", vbInformation
Else
    Application.ScreenUpdating = False
        Set con = VBA.CreateObject("adodb.Connection")
        
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
        
        sorgu = "select İlçesi,[Tesis Türü],[İşin Adı],year([İş Bitiş Tarihi]),Açıklama,[2020 YILI FİYATLARI İLE TOPLAM MALİYET] " & _
          "from[VERİ$A2:BU" & son & "] where [İlçesi]='" & Target & "'"
        
        Set rs = con.Execute(sorgu)
        
        [C8].CopyFromRecordset rs
        
        enson = Cells(Rows.Count, "B").End(3).Row
        For i = 8 To son
            Cells(i, "B") = i - 7
        Next
        Range("F8:F" & enson).NumberFormat = "General"
    Application.ScreenUpdating = True
End If
End Sub
 

okavut

Altın Üye
Katılım
22 Şubat 2007
Mesajlar
163
Excel Vers. ve Dili
excel 2016 TR
Altın Üyelik Bitiş Tarihi
12-01-2028
Sayın Yusuf bey teşekkür ederim.
işlere ait maliyetler gelmiyor sadece
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
SORU sayfasında "2020 Yılı Fiyatlarıyla Maliyeti" şeklinde sütun başlığı olduğundan ben de buna uyumlu olarak VERİ sayfasındaki AR sütununu olduğunu düşünmüştüm. Eğer VERİ sayfasındaki L sütununu almak istiyorsanız koddaki
[2020 YILI FİYATLARI İLE TOPLAM MALİYET]

Yerine

[TOPLAM MALİYET]

yazın.

Not: Bu değişikliği yaparken köşeli parantezin kapatılmasından sonra bir boşluk olduğunu unutmayın. Boşluğu silerseniz kod çalışmaz.
 

okavut

Altın Üye
Katılım
22 Şubat 2007
Mesajlar
163
Excel Vers. ve Dili
excel 2016 TR
Altın Üyelik Bitiş Tarihi
12-01-2028
Yusuf Bey Çok Teşekkür ederim.
Saygılarımla
 
Üst