Excel de Bilgi Girisi Saglamak

[sihirbaz31]

Excel de soyle bir sistem kurma imkanim varmidir acaba.

Ornegin bir tablomuz var sayfa 1 de
Bunun icinde doldurulmasi gereken alanlar var
Kullanici bu bos kutulara bastigi zaman karsisina 2. sayfada onceden hazirlamis oldugum sorulari cikartip bir bilgi penceresinde, oraya cevabini girmesini saglamak istiyorum. Bu girdigi cevabi da direk 1 sayfada tikladigi kutucugun icine yazmak istiyorum.
Onceden doldurmus oldugu kutucuga tekrar basarsa kullanici tekrar sayfa 2 deki ayni soru ile karsilasip, yeni girdigi degerin o kutuya yazilmasini istiyorum.

bunu yapmak mumkunmudur acaba.

 

[Necdet]

Merhaba,

Siz önce örnek bir dosya ile sorunuzu destekleyin, sonrasına fikri olan arkadaşlar sihirbazlıklarını gösterirler diye düşünüyorum.

 

[sihirbaz31]

Tekrardan merhabalar,

Ekte ornek bir dosya yarattim umarim ise yarar. Kullanicilarin sadece sayfa 1 i gormelerini saglayacagim sayfa 2 yi saklayacagim. Ornegin kullanici C3 e tikladiginda yeni bir pencere acilip sayfa2 deki B2 nin karsisina cikmasini ve girdigi cevabin da sayfa 1 deki C3 e yazilmasini istiyorum. Bunun yani sira sorular sadece alt alta degil baska sutunlarda olabilir. her soruyu her kutucuga bir sekilde atamam gerekiyor.

Umarim anlatabilmisimdir.

Yardim edenlere simdiden cok tesekkur ederim.

 

[Necdet]

Merhaba,

Çözümü beğenir misiniz bilemem, inceleyiniz.

Aşağıdaki kodlar Sheet1'in kod bölümünde olmalı.

B sütunundaki veriler Sheet2 de A sütununda olmalı ve karşılığında sorulacak soru B sütununda yazılması gerekmektedir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Intersect(Target, [C:C]) Is Nothing Or _
        Target.Row < 3 Then Exit Sub
    
    Dim Soru    As String
    Dim Yanit
    Dim c       As Range
    
    Yanit = ""
    
    Set c = Sheets("Sheet2").Range("a:a").Find(Target.Offset(0, -1).Value, LookIn:=xlValues)
    If Not c Is Nothing And c.Offset(0, 1).Value = "" Then Exit Sub
    Soru = c.Offset(0, 1).Value
    Yanit = Application.InputBox(Prompt:=Soru)
    If Not Yanit = "" And Not Yanit = False Then Target.Value = Yanit
    
End Sub

 

[sihirbaz31]

Oncelikle tesekkur ederim cevabiniz icin.
Ancak ben bu sekilde oldugu zaman sadece sayi girebiliyorum.
Bunu hem sayi hemde isim yada yazi girilecek sekilde degistirme imkanimiz varmi acaba.
Birde yazilar asagida olursa nasil yapacam bu islemi.
yani sitedigim kutucuya istedigim soruya nasil yonlendirme yapabilirim.
sizin gonderdiginiz makrodan tam bunu anlayamadim dogrusu.
yapma ya calistigim seyin sirasiz oldugunu dusunursek bu mumkunmudur?

Merhaba,

Çözümü beğenir misiniz bilemem, inceleyiniz.

Aşağıdaki kodlar Sheet1'in kod bölümünde olmalı.

B sütunundaki veriler Sheet2 de A sütununda olmalı ve karşılığında sorulacak soru B sütununda yazılması gerekmektedir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Intersect(Target, [C:C]) Is Nothing Or _
        Target.Row < 3 Then Exit Sub
    
    Dim Soru    As String
    Dim Yanit   As String
    Dim c       As Range
    
    Yanit = ""
    
    Set c = Sheets("Sheet2").Range("a:a").Find(Target.Offset(0, -1).Value, LookIn:=xlValues)
    If Not c Is Nothing And c.Offset(0, 1).Value = "" Then Exit Sub
    Soru = c.Offset(0, 1).Value
    Yanit = Application.InputBox(Prompt:=Soru)
    If Not Yanit = "" And Not Yanit = False Then Target.Value = Yanit
    
End Sub

 

[Necdet]

Merhaba,

Önceki mesajımdaki kodları ve dosyayı yeniledim.

Sözcükler arasındaki ilişkiyi anlamak için 2. sayfaya bakınız.

 

[sihirbaz31]

Cok tesekkur ederim. Artik isim ve bilgi girisinde sorun cozuldu. Hem isim hemde sayi girebiliyorum kutulara.
Ancak simdide soyle bir sorunum var. Devamli alt alta degil kutucuklar. Rastgele olarak dusunursek, bu sistem ona uymuyor. Ornegin bazen altina girmem girekiyor datayi bazen de ayni sutunun altina bir kac tane. (her kutucukta farkli soru cikacak sekilde)

Ornek olarak farkli bir tablo yarattim.
Benim icin her kutucuya bir soru atama yontemi gerekiyor aslinda anladigim kadariyla sirali sistem bana uymuyor cunku.

Yardimici olursaniz cok sevinirim.

Tesekkurler

 

[Necdet]

Merhaba,

Siz öneride bulunun kodları biz yazmaya çalışırız elimizden geldiğince.

Ama siz herşeyi siz yapın diyorsunuz.

İşin sahibi sizsiniz.

 

[sihirbaz31]

Merhabalar,

inanin anlayabilsem su kodlari hemen yapacam. Ancak anlayamiyorum. Su ufak tabloyu halledebilsem yapmam gereken tablo bundan cok buyuk, onu kendim adepte etmeye calsisicam.

Yardimci olursaniz son kez cok sevinirim.