A1 Hücresini Farklı bir sayfadan süzmesini...

[doukan84]

Vereceğeniz cevaplar için önceden teşekkür ediyorum arkadaşlar.. çünkü bu forum cidden ufkumu genişletiyor...


Evet arkadaşlar Ben herhangi bir sayfadaki A1 hücresinin içeriğinin aynı dosyadaki yada farklı bir dosyadaki Komple A sütunu süzmesini ve ordaki, seçeneklerden birini seçtiğim zaman(örnek A20 deki bir yazıyı) bu sutunun yanındaki açıklamayı Benim B sutunumdaki herhangi bir hücreye o yazıyı getirmesini istiyorum... Bilmem anlatabildimmi yada çok şeymi istiyorum..

Hepinizi çok seviyorum saygılarımla...

 

[Orion1]

Vereceğeniz cevaplar için önceden teşekkür ediyorum arkadaşlar.. çünkü bu forum cidden ufkumu genişletiyor...


Evet arkadaşlar Ben herhangi bir sayfadaki A1 hücresinin içeriğinin aynı dosyadaki yada farklı bir dosyadaki Komple A sütunu süzmesini ve ordaki, seçeneklerden birini seçtiğim zaman(örnek A20 deki bir yazıyı) bu sutunun yanındaki açıklamayı Benim B sutunumdaki herhangi bir hücreye o yazıyı getirmesini istiyorum... Bilmem anlatabildimmi yada çok şeymi istiyorum..

Hepinizi çok seviyorum saygılarımla...

örnek dosya eklerseniz ve üzerinde açıklama yaparsanız konunuza daha çabuk yardım alabilirsiniz kanaatindeyim.
Kolay gelsin.

 

[doukan84]

örnek dosya eklerseniz ve üzerinde açıklama yaparsanız konunuza daha çabuk yardım alabilirsiniz kanaatindeyim.
Kolay gelsin.

Ekledim teşkkür ederim

 

[Orion1]

Sayfa1 de dosyanız 2 adet başlık ekledim.
Dosyanız ektedir.

Sub ado_ile_ders_al_59()
Dim conn As Object, rs As Object
Sheets("Sayfa2").Range("A2:A" & Rows.Count).Clear
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select distinct DERS from [Sayfa1$A:A];", conn, 1, 1
Sheets("Sayfa2").Range("A2").CopyFromRecordset rs
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim conn As Object, rs As Object
Range("B:B").Clear
Sheets("Sayfa2").Range("B2:B" & Rows.Count).Clear
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select NOTLAR from [Sayfa1$A:B] where DERS='" & _
    Range("A1").Value & "';", conn, 1, 1
Sheets("Sayfa1").Range("B1").CopyFromRecordset rs
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
End Sub

 

[doukan84]

Sayfa1 de dosyanız 2 adet başlık ekledim.
Dosyanız ektedir.

Sub ado_ile_ders_al_59()
Dim conn As Object, rs As Object
Sheets("Sayfa2").Range("A2:A" & Rows.Count).Clear
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select distinct DERS from [Sayfa1$A:A];", conn, 1, 1
Sheets("Sayfa2").Range("A2").CopyFromRecordset rs
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim conn As Object, rs As Object
Range("B:B").Clear
Sheets("Sayfa2").Range("B2:B" & Rows.Count).Clear
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select NOTLAR from [Sayfa1$A:B] where DERS='" & _
    Range("A1").Value & "';", conn, 1, 1
Sheets("Sayfa1").Range("B1").CopyFromRecordset rs
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
End Sub

Cidden tebrikler süper olmuş elinize sağlık hocam.. Birde bunu çalışma sayfasında B1 hücresine aktarıyor ya oraya değilde farklı bir sayfadaki yere aktarsa veya sayfa 2 deki yere aktarsa o derslerin açıklamalı halini menüden seçtiğim zaman Bir buton yapsak acaba mümkünmü çok makbule geçer vede Dileyin benden ne dilerseniz :dua:

 

[Orion1]

Cidden tebrikler süper olmuş elinize sağlık hocam.. Birde bunu çalışma sayfasında B1 hücresine aktarıyor ya oraya değilde farklı bir sayfadaki yere aktarsa veya sayfa 2 deki yere aktarsa o derslerin açıklamalı halini menüden seçtiğim zaman Bir buton yapsak acaba mümkünmü çok makbule geçer vede Dileyin benden ne dilerseniz :dua:

Sayfa3 e yaptım.
Böylemi olacak,tam da anlayamadım aslında.
Dosya ektedir.

 

[doukan84]

conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"

Şu 2 kodda hocam hata alıyorum excel 2003 yüklü iş yeri bilgisayarımda.. acaba neden ? Bir yardım ederseniz sevinirim

 

[Orion1]

conn.Open "Provider=microsoft.ace.oledb.12.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"";"

Şu 2 kodda hocam hata alıyorum excel 2003 yüklü iş yeri bilgisayarımda.. acaba neden ? Bir yardım ederseniz sevinirim

2003 için aşağıdaki yazdığım kodu kullanın.

conn.open "Provider=microsoft.jet.oledb.4.0;" & "data source=" & _
    ThisWorkbook.Path & "\veritabanı.xls;extended properties=""excel 8.0;hdr=yes;imex=1"";"

 

[doukan84]

conn.open "Provider=microsoft.jet.oledb.4.0;" & "data source=" [COLOR="Red"]& _[/COLOR]
    ThisWorkbook.Path [COLOR="Red"]&[/COLOR] "\veritabanı.xls;extended properties=""excel 8.0;hdr=yes;imex=1"";"

Hocam şimdide şu kırmızı ile seçtiğim 2 yeri hata olarak görüyor

 

[Orion1]

xls dosyalarınız ektedir.

 

[doukan84]

xls dosyalarınız ektedir.

Hocam size dün geceki yardımlar için çok teşekkür ederim.. Aslında yapmak istediğimi bugün sakin kafa ile çizdim.. bunu 2007 excel kullandığım için indis komutu ve liste oluştur ile tek çalışma sayfası üzerinden yaptım...

Ama ofisde kullandığım sürüm 97-2003 ve Tek çalışma sayfası değilde ordaki her sayfa farklı bir dosya olacak Yani sayfa1 veritabanı isimli bir dosya Sayfa2 Aylık eğitim planı isimi bir dosya sayfa3 de Haftalık eğitim programı isimli bir dosya olacak... Sizin gönderdiğiniz dosya üzerinde biraz çalıştım ama beceremedim.. en azından yapmak isteiğimi suan çok iyi anlarsınız ekteki dosya ile