DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Listele()
Dim c As Range
Dim s1 As Worksheet, s2 As Worksheet
Dim sat As Long
Dim Adres As String
Set s1 = Sheets("ekran")
Set s2 = Sheets("veritabanı")
sat = 0
Application.ScreenUpdating = False
Range("B:C").ClearContents
With s2.Range("A:A")
Set c = .Find(s1.[A1], LookIn:=xlValues)
If Not c Is Nothing Then
Adres = c.Address
Do
sat = sat + 1
Cells(sat, "B") = s2.Cells(c.Row, "B")
Cells(sat, "C") = s2.Cells(c.Row, "C")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adres
End If
End With
Application.ScreenUpdating = True
MsgBox "Bulduklarımı Getirdim"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a:a]) Is Nothing Or Target = "" Then Exit Sub
Set Bul = [veritabanı!a:a].Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not Bul Is Nothing Then
Target.Offset(0, 1) = Sheets("veritabanı").Cells(Bul.Row, "b")
Target.Offset(0, 2) = Sheets("veritabanı").Cells(Bul.Row, "c")
End If
End Sub
ektekı dosyada açıkladım yardımcı olursanız sevınırım
alternatif olsun, çözüm makrosuzdur. iyi çalışmalar dilerim.
sayın gokhan polat cok teşekkurler cok yararlı oldu ama ben bunu tum a sutunu ıcın yapmak istiyorum. nasıl yapabılırım
rica ederim, "ekran" sayfasındaki B ve C sütunundaki formüller dilediğiniz kadar aşağıya kopyalayabilirsiniz, ayrıca "ekran" sayfasının A sütununda herhangi bir hücreye tıkladığınızda "veritabanı" sayfasının A sütunundaki değerler görüntülenecektir. Dosya ektedir. İyi çalışmalar dilerim
cok ıyı oldu gokhan polat.tekrar teşekkurlewr bunu nasıl yaptık verı suzden mı?ben kendım yapmaya calısıyorum bı turlu olmuyor. sayfa 1 dekı vwerılerı sayfa 2 den suzemıyorum