V

Çözüldü Butona atanmış kodu ENTER e atamak

  • Konuyu başlatan Konuyu başlatan vurkan
  • Başlangıç tarihi Başlangıç tarihi

vurkan

Normal Üye
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Arkadaşlar merhaba. Aşağıdaki kod ile aranan kelimeyi sekmeler içinde arayıp gerekli yerlere getiriyorum. Ben kod yazmayı bilmiyorum. Bu kodu internetten buldum. Bir modülde bulunan Bu kodda nasıl bir değişiklik yaparsam sonuc isimli sayfanın B1 hücresine (B1 hücresi B1:D2 aralığında birleştirilmiştir) yazdıktan sonra enter tuşuna basınca hemen çalışsın. Saygılar.

Sub ogrenci_ara()
On Error Resume Next
Dim x, y, Sayfa, a, satir, sutun, sonBulunanSatir As Integer
Dim no As String
Dim bilgiBulundu As Boolean
bilgiBulundu = False

no = 2000 'bilgilerin bulunduğu sayfa isimlerinin ilki, 2000 yılını ifade ediyor
satir = 5 'sonuç ekranında bilgilerin aktarılacağı ilk satır

'ekranın güncellemesini geçici olarak durdurur
'böylece hem işlemler daha hızlanır hem de ekranda oluşan sayfa geçişleri engellenmiş olur
Application.ScreenUpdating = False

'aşağıdaki satır sonuç sayfasındaki bulunmuş olan bilgileri siler
'Aralığı tablonuza göre değiştirmelisiniz.
'Kod A5:C1000 arasındaki hücreleri siler
Range("A5:J1000").ClearContents
Range("B1").Select
If Range("B1").Value = "" Then
Range("B1").Value = InputBox(prompt:="Lütfen Ad Soyad Giriniz...", _
Title:="Hatalı Giriş", Default:="buraya yazınız")
End If
'..sonuç b1 hücresine arama yapmak istediğimiz isim yazılacak
Cells.Find(What:=[B1], After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

For Sayfa = CInt(no) To CInt(no) + Sheets.Count - 2
'Aşağıdaki bölümde ilgili sayfaya gidilip, aramanın yapılacağı B sütununun ilk hücresi seçiliyor
Sheets(CStr(Sayfa)).Select
no = CStr(Sayfa)
Range("b1").Select
sonBulunanSatir = 1
y = 1

'Aşağıdaki bölümde ilgili sayfadaki B sütununda arama yapılıp, bulunan bilgiler aktarılıyor.
For a = 1 To 1000
bulundu = Cells.FindNext(After:=ActiveCell).Activate
'eğer bir bilgi bulunmadıysa sonraki sayfaya geçer
If bulundu <> True Then Exit For
x = ActiveCell.Column
y = ActiveCell.Row
'eğer arama işlemi başa dönerse döngüden çık diğer sayfaya geç
'yani kayıt bulunamadığında ya da son bilgi bulunup, arama başa döndüğünde
If (y <= sonBulunanSatir) Then Exit For
sonBulunanSatir = y
bilgiBulundu = True

'Bulunan bilgiler sonuç sayfasına aktarılıyor
'diğer sütunlardaki bilgiler de aynı şekilde yazılan kodlarla aktarılmalıdır.
'aşağıdaki kod üç bilgiyi aktarmaktadır
Sheets("sonuc").Cells(satir, 1) = Sheets(no).Cells(y, 1)
Sheets("sonuc").Cells(satir, 2) = Sheets(no).Cells(y, 2)
Sheets("sonuc").Cells(satir, 3) = Sheets(no).Cells(y, 3)
Sheets("sonuc").Cells(satir, 4) = Sheets(no).Cells(y, 4)
Sheets("sonuc").Cells(satir, 5) = Sheets(no).Cells(y, 5)
Sheets("sonuc").Cells(satir, 6) = Sheets(no).Cells(y, 6)
Sheets("sonuc").Cells(satir, 7) = Sheets(no).Cells(y, 7)
Sheets("sonuc").Cells(satir, 8) = Sheets(no).Cells(y, 8)
Sheets("sonuc").Cells(satir, 9) = Sheets(no).Cells(y, 9)
Sheets("sonuc").Cells(satir, 10) = Sheets(no).Cells(y, 10)

satir = satir + 1
Next a
Next Sayfa

Sheets("sonuc").Select
Range("b1").Select
Application.ScreenUpdating = True
If bilgiBulundu = False Then MsgBox Range("b1").Value + " Adında Öğrenci Bulunamadı!"
End Sub
 
@Vurkan

Merhaba, geç oldu ve deneme şansım da yok şu an.
Ancak B1 hücresi üzerinden Worksheet_Change kodu çalıştırılabilir.
Önce bu konuyla ilgili forumda arama yapın (çok sayıda örnek var).

Bu kodlamada kodun en başında tetikleme hücresi B1 hücresi olarak tanımlanır.

Ondan sonraki kısımlardaki (Cells.Find(What:=[B1] kısmından başlayarak) B1 yerine Target veya Target.Value diye
yazarak bir deneyin isterseniz.
Umarım vakti uygun olan başka bir armadaşımız konuyla ilgilenir.
İki gün, SINAV günümüz.

.
 
@Vurkan

Sanırım en pratik, daha doğrusu; belgeye/kodlara en az müdahale edilerek çözüm şöyle;
-- sonuc isimli sayfadaki "Öğrencileri Bul" düğmesini silin,
-- alt taraftan sonuc isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- karşınıza gelecek VBA ekranında sağdaki boş alana aşağıda birinci kod blokundaki kodu yapıştırın.
-- ogrenci_ara makro kodunda yer alan ve aşağıda ikinci kod blokunda kırmızı renklendirdiğim satırları silin veya
bu satırların sol başına TEK TIRNAK ekleyerek etkisiz hale getirin.

VBA:
Görüntülemek için giriş yapmanız gerekmektedir.
(16 satır)

VBA:
Görüntülemek için giriş yapmanız gerekmektedir.
(8 satır)

.
 
Üst