Ayrı sayfalardan koşullu veri arama ve aktarma

[seymen34]

Merhaba arkadaşlar, Ekli dosyada da belirttiğim üzere "müşteri" isimli sayfamdaki verilerin diğer 4 sayfada aranması ve varsa karşılarına bilgi mesajları yazılması ile ilgili sorunuma yardımcı olmanız dileğimle. Bu işlemlerin butonlar yardımıyla yapılmasınin göze daha hoş görüneceğini düşündüm. Yardımcı olabilecek arkadaşlarıma şimdiden çok teşekkür ediyorum.

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, herhangi bir modul sayfasına yapıştırınız ve ilgili butonlara bağlayınız. Diğer dosyalarınız kapalı bile olsa istediğiniz işlem gerçekleşecektir

[B][COLOR=red]'----ÖNEMLİ-----------^
'Kodları çalıştırmadan önce;
'Tool > References
'1. Microsoft ADO Ext 2.x for DLL or Security
'2. Microsoft ActiveX Data Object 2.x Library
'referanlarını işaretleyin.
'Tüm dosyaların aynı klasör altında olduğu varsayımı ile hazırlanmıştır.[/COLOR][/B]
Sub FK()
Set sh = Sheets("müşteri")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
sonsat = sh.Cells(65536, 2).End(xlUp).Row
connstr = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & ThisWorkbook.Path & "\FK.xls; ReadOnly=False;"
conn.ConnectionString = connstr
conn.Open
Sql = "SELECT * FROM [FK$]"
rs.Open Sql, conn, adOpenForwardOnly, adLockReadOnly
rs.MoveFirst
Do Until rs.EOF
     For i = 2 To sonsat
          If sh.Cells(i, 2) = rs(1) And sh.Cells(i, 4) = rs(2) Then: sh.Cells(i, 6) = "FK"
     Next i
     y = y + 1
     rs.MoveNext
Loop
conn.Close
Set sh = Nothing
Set conn = Nothing
Set rs = Nothing
End Sub

Sub GK()
Set sh = Sheets("müşteri")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
sonsat = sh.Cells(65536, 2).End(xlUp).Row
connstr = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & ThisWorkbook.Path & "\GK.xls; ReadOnly=False;"
conn.ConnectionString = connstr
conn.Open
Sql = "SELECT * FROM [Sayfa1$]"
rs.Open Sql, conn, adOpenForwardOnly, adLockReadOnly
rs.MoveFirst
Do Until rs.EOF
     For i = 2 To sonsat
          If sh.Cells(i, 2) = rs(2) And sh.Cells(i, 4) = rs(3) Then: sh.Cells(i, 6) = "GK"
     Next i
     y = y + 1
     rs.MoveNext
Loop
conn.Close
Set sh = Nothing
Set conn = Nothing
Set rs = Nothing
End Sub

 

[seymen34]

"Önemli" kısmında belirtilen seçenekler...

Aşağıdaki kodları, herhangi bir modul sayfasına yapıştırınız ve ilgili butonlara bağlayınız. Diğer dosyalarınız kapalı bile olsa istediğiniz işlem gerçekleşecektir

[B][COLOR=red]'----ÖNEMLİ-----------^
'Kodları çalıştırmadan önce;
'Tool > References
'1. Microsoft ADO Ext 2.x for DLL or Security
'2. Microsoft ActiveX Data Object 2.x Library
'referanlarını işaretleyin.
'Tüm dosyaların aynı klasör altında olduğu varsayımı ile hazırlanmıştır.[/COLOR][/B]

Sevgili fpc,
Önemli kısmında belirtilen seçenekleri nereden işaretlemem gerekiyor. Araçlar menüsünde Referans hangisidir. Ben türkçe ofis 2000 kullanıyorum.
Yardımın için çok teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Excelinizde sadece Musteri.xls kitabı açık olsun; (Bunu bir defaya mahsus yapacağız. Sadece bu işlem için)

"Araçlar" menüsünden "Makro"yu ve "Visual Basic Düzenleyicisi"ni (VBE)seçin.

Şu an VBE'ye girmiş olmanız lazım.

VBE'nin menüsünden "Tools" -> "References"'i tıklayın. Önünüze bir liste gelecek. Bu listeden yukarıda söylediğim isimleri bulun ve işaretleyin. "OK" deyip çıkın. Excel'e dönüp kitabınızı kaydedin.

İşlem tamam. Kolay gelsin.

 

[seymen34]

Şöyle bir hata iletisi alıyorum.

Değerli arkadaşım, butonlara söymiş olduğun makroyu, VB'ye yazarak bağladım ve butona tıkladığımda şöyle bir hata iletisi alıyorum.
Compile error: user-defined type not defined.ve şu kısımdaki alan uyarı için sarı renkle gösterilmiş.
Sub FK()
Set sh = Sheets("müşteri")
Set conn = New ADODB.Connection
GK içinde aynı uyarı kısmı renklendirilmiş.
Nasıl bir çözüm önerebilirsin acaba? Teşekkürler.

 

[seymen34]

Şöyle bir hata iletisi alıyorum.

Değerli arkadaşım, butonlara söymiş olduğun makroyu, VB'ye yazarak bağladım ve butona tıkladığımda şöyle bir hata iletisi alıyorum.
Compile error: user-defined type not defined.ve şu kısımdaki alan uyarı için sarı renkle gösterilmiş.
Sub FK()
Set sh = Sheets("müşteri")
Set conn = New ADODB.Connection
GK içinde aynı uyarı kısmı renklendirilmiş.
Nasıl bir çözüm önerebilirsin acaba? Teşekkürler.

DOSYALAR EK' TEDİR.

 

[geren36]

'Tool > References' da

Microsoft ADO Ext 2.5 for DLL and Security ve

Microsoft ActiveX Data Object 2.5 Library

seçeneklerinin sol yanındaki küçük kutucukları işaretleyiniz...

 

[seymen34]

FK dosyam çalıştı,ancak diğerleri...?

Değerli arkadaşım,
söylemiş olduğun şekilde düzelme yapınca FK BUTONUM çalışmaya başladı, çok teşekkür ederim. Ancak GK, EKSTRE VE KARŞILIK DOSYASI butonlarım halen çalışmıyor. Ekstre ve karşılık dosyalarımın kodları yazılı değil zaten. Bunları VB' deki kod sayfasına nasıl eklerim??
çok teşekkürler.

 

[Ferhat Pazarçevirdi]

Lütfen, bu dosyayı kullanınız.

 

[ismailuguz]

merhaba benim de benzer bir sorunum var yardım ederseniz sevinirim !!!

http://www.excel.web.tr/showthread.php?t=34689

teşekkürler.

 

[seymen34]

Hata iletisi alıyorum...

şöyle bir hata iletisi alıyorum.

Sub KD()
Set sh = Sheets("müşteri")
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
sonsat = sh.Cells(65536, 2).End(xlUp).Row
connstr = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & ThisWorkbook.Path & "\KD.xls; ReadOnly=False;"
conn.ConnectionString = connstr
conn.Open
Sql = "SELECT * FROM [Sayfa1$]"
rs.Open Sql, conn, adOpenForwardOnly, adLockReadOnly

 

[Ferhat Pazarçevirdi]

Sn.Seymen34
Muhtemelen; "KD.xls" dosyanızdaki sheet'in adı "Sayfa1" olmayabilir. Lütfen bunu kontrol ediniz.

 

[seymen34]

dosya ismim doğru...

dosya ismi sayfa1 yazıyor. ancak sorunu bulamadım.
Tşk.