Başka kitapdan düşeyara

[mehmetcan]

Hepinize kolay gelsin,
Þöyle bir sorunum var:

-Sabit bir çalışma kitabı var,örneğin; C\a.xls gibi,sayfa1,sayfa2 den oluşan ve A sutununda firma ismi B sutununda da firma kodu var
-Yeni kitapda A1 hücresine firma ismi girildiğinde bir msgbox yardımı ile A1 firmasını hangi sayfada olduğunu ve kodunu yazdırmak mümkün mü?

Teşekkürler

 

[bedersu]

Merhaba

ThisWorkbook kısmına;

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call al
End Sub

Sonra da bir module içine;

Sub al()
On Error Resume Next
bul = Cells(1, 1)

Workbooks.Open "C:\a.xls"
For i = 1 To Sheets.Count
Sheets(i).Activate
a = Cells.Find(What:=bul, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Activate

If a = "" Then GoTo yeniden:
yeniden:
If a <> "" Then GoTo yeniden2:

Next

yeniden2:
adres = ActiveCell.Offset(0, 1).Value
sayfa = ActiveSheet.Name
ActiveWorkbook.Close
MsgBox adres + Chr(13) + sayfa
End Sub

İstediğiniz bu gibi birşey mi?

 

[mehmetcan]

Çok teşekkür ederim,
İstediğim tarzda çalışıyor fakat sorumdan kaynaklanan bir hata gerçekleşmiş,ben A sutunun tamamında düşeyara yapmasını istiyorum mümkünse(sadece A1 de yapıyor yukarıdaki kodlar)
Küçük bir ricam daha olacak msgbox görünerek veya görünmeyerek firma kodunu yan hücreye yazdırabilir miyiz? :?

 

[bedersu]

Merhaba,
Benim yazdığım kodlarla bütün kitap aranıyor ve A1 hücresine yazmış olduğunuz veri eşleştiriliyor.Veri bulununca hemen yan hücredeki firma kodu ve bulunan sayfa da alınıp mesgbox olarak veriliyor.Sadece bir sütun aranmıyor.
Yok ben 20-30 firma birden aratmak istiyorum diyorsanız bu biraz değişik olur.Soru tamamen değişir.bunu biraz daha aydınlatın.Dediğim gibi ben tek bir sütunda değil , olası bir karışıklığa karşı , bütün çalışma kitabında arattım.Ama isterseniz daha da kısıtlanır , sayfa ismi manuel yazılır , sayfada değil tek bir sütunda aratılabilir ama kısır olur bence. Sizce? Siz bu şekilde mi istiyorsunuz?

sorunuzun ikinci kısmı kolay.

ActiveWorkbook.Close kısmından hemen sonra
cells(1,2)= adres & " " & sayfa
yazın.

 

[mehmetcan]

İlginiz için teşekkürler,

Kısaca şöyle özetlemek istiyorum; A sutunun sonuna kadar yazılacak firma isimleri olsun(abartı ama olayı biraz daha kolaylaştırmak adına firma isimleri yazılsın ve tuşa basıldığı zaman a.xls den düşeyara yaparak yan hücrelerine firma kodlarını yazsın,Saolun

 

[bedersu]

Merhaba,

Aşağıdaki kodlar işinizi görür.Ben 500 veri ile kısıtladım.Bu bile benim bilgisayarda 2 saniye alıyor.Bütün satırların dolu olduğu düşünülürse arama biraz vakit alır.

Kodları Kitap1 içinde bir module'e yazdıktan sonra butona atayın ve çalıştırın.
Kolay gelsin.

Sub al()
On Error Resume Next
Workbooks.Open "C:\a.xls"

For i = 1 To 500

bul = Workbooks("Kitap1").Sheets("Sayfa1").Cells(i, 1).Value


a = Cells.Find(What:=bul, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Activate

Workbooks("Kitap1").Sheets("Sayfa1").Cells(i, 2).Value = ActiveCell.Offset(0, 1).Value


Next

ActiveWorkbook.Close
End Sub