• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

TextBox1'e belirli hücredeki yazıdan başka text girilmesin

A

Aliska

Katılım
19 Ağustos 2022
Mesajlar
12
Excel Vers. ve Dili
Ofis LTSC 2021 Pro
Arkadaşlar benim iki sayfalı bir excel çalışma kitaplığım var. 1. sayfa veriler 2. sayfa data(matriksten çektiğim 4 sütündan oluşan verilerden oluşmakta) ben 1. sayfaya bir userform oluşturdum ve 4 tane textbox var 2 de button var. Benim sorum ilk textbox'a sadece data sayfasındaki hisse isimleri yazılabilsin eşleşme olmazsa hata versin istiyorum. Bu kodu nasıl yazabilirim? Şimdiden yardım edeceklere teşekkür ederim
 
Merhaba,

Textbox taki değeri belirttiğiniz alanda aratırsınız, buldunuz buldunuz, bulamadınız yeniden giriş yaptırırsınız.

Örnek dosya olmayınca açıklamayı yeterli bulmalısınız.
 
hocam textbox içine yazdığım değeri data sayfasından ''A'' sütunundan düşey ara ile mi aratacağım?
 
Vba nın kendi FIND komutu var, onu kullanabilirsiniz.
Aşağıdaki kod Textbox1.exit durumunda textbox1'in değerini Data sayfasının A sütununda arar, bulamazsa textbox1 den çıkmaz, bulursa bir sonraki objeye geçer.

Kod: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim c As Range

    Set c = Sheets("Data").Range("A:A").Find(Trim(TextBox1.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If c Is Nothing Then
        MsgBox "Aranan Değer Bulunamadı..:"
        Cancel = True
    End If
    
End Sub
 
Son düzenleme:
Necdet' Alıntı:
Vba nın kendi FIND komutu var, onu kullanabilirsiniz.
Aşağıdaki kod Textbox1.exit durumunda textbox1'in değerini Data sayfasının A sütununda arar, bulamazsa textbox1 den çıkmaz, bulursa bir sonraki objeye geçer.

Kod: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim c As Range

    Set c = Sheets("Data").Range("A:A").Find(Trim(TextBox1.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If c Is Nothing Then
        MsgBox "Aranan Değer Bulunamadı..:"
        Cancel = True
    End If
   
End Sub
Genişletmek için tıkla ...

Hocam çok teşekkür ederim çalıştı istediğim oldu.. kaç gündür uğraşıyordum.. müteşekkirim sağolun. Yoruyorum ama bir de şunu merak ediyorum hisse kısaltmaları 4-5 harften oluşuyor ilk iki harfi yazınca tamamlama yaptırabilir miyiz? Textbox içinde mümkün müdür?
 
Merhaba,
Hisse kısaltmaları dediğinize göre istanbul borsasındaki şirket isimlerinden söz ediyorsunuz sanırım.
Hiç düşünmedim böyle bir şeyi. Siz hisse kısaltmalarına bir örnek verirseniz yardımcı olacak arkadaşlar çıkacaktır.
 
Hocam benim ''Data'' sayfasında ''Hisse adı'' ''Son fiyat'' ve ''Değişim'' olmak üzere 3 sütun var. Sizin yazdığınız kodla hisse adını Textbox1 e yazdırdım hatalar önlenmiş oldu bu bana gerekliydi çünkü eksik veya yanlış girilen hisse adı hesaplarda yanlışlıklara sebep veriyordu. Şimdi hisse ad kısaltmaları büyük harfle 4-5 harften oluşuyor.. SAHOL, AKBNK, FADE, ENJSA .... gibi bunların ilk 2 harfini girince otomatik tamamlama yapılabilir mi? combobox istemiyorum 500 hisse var. teşekkür ediyorum

bu videoda anlatmış istediğimi ama ben de hata verdi yapamadım.
 
Textbox yerine listbox kullanmak daha doğru olur. Listbox kullanırsanız Textbox aracılığıyla listboxtaki verileri istediğiniz gibi süzebilirsiniz.
 
Bu kodlarla çalıştı hem tamamlıyor hem de kontrolü yapıyor. umarım doğru yapmışımdır. Ama ayrı yordamlarda oldu, birleştirmeye gerek var mı?

Kod: 
Private Sub TextBox1_AfterUpdate()
For i = 1 To 500
A = Me.TextBox1.TextLength
If LCase(Left(Sayfa2.Cells(i, "A"), A)) = Me.TextBox1 Or _
UCase(Left(Sayfa2.Cells(i, "A"), A)) = Me.TextBox1 Then
Me.TextBox1 = Sayfa2.Cells(i, "A")
End If
Next i

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim c As Range

    Set c = Sheets("Data").Range("A:A").Find(Trim(TextBox1.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If c Is Nothing Then
        MsgBox "Aranan Deger Bulunamadi..:"
        Cancel = True
    End If
    
End Sub
 
Merhaba,

Sizin kodlarınızı bir sütuna haftanın günlerini yazarak denedim.
Pazar'ı bir türlü yazamadım, sürekli pazartesiye çeviriyor.

Bu yüzden Sayın Yusuf44'ün önerisini dikkate alınız.
 
Örnek dosya paylaşırsanız listboxlı çözüme örnek hazırlamaya çalışırım.
 
Sayın Hocalarım hepinize teşekkürler. Kodlar çalışıyor ama excelde kasmalara çok ram tüketiyor ve donmalara sebep oluyor. Acaba kodlarla ilgili bir sorun mu var kontrol etme şansınız olursa sevinirim. Ben makro bilmiyorum öğrenmeye çalışıyorum. Ben dosya ekleyemiyorum galiba.
kodlarımı eklemek istiyorum Teşekkürler
Kod: 
Private Sub CommandButton1_Click()

If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox4 <> "" Then

        Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Offset(1, 0) = TextBox1.Value

        Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Offset(1, 0) = CDate(TextBox2.Value)

        Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Offset(1, 0) = CDbl(TextBox3.Value)

        Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Offset(1, 0) = CDbl(TextBox4.Value)

        Unload Me

  Else

  MsgBox "Alanlar Boş Bırakılamaz...!", vbInformation, "Hata!!"

  End If

End Sub

Private Sub CommandButton2_Click()

If TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "" And TextBox4 <> "" Then

        Cells(ActiveSheet.Rows.Count, 12).End(xlUp).Offset(1, 0) = TextBox1.Value

        Cells(ActiveSheet.Rows.Count, 13).End(xlUp).Offset(1, 0) = CDate(TextBox2.Value)

        Cells(ActiveSheet.Rows.Count, 14).End(xlUp).Offset(1, 0) = CDbl(TextBox3.Value)

        Cells(ActiveSheet.Rows.Count, 15).End(xlUp).Offset(1, 0) = CDbl(TextBox4.Value)

        Unload Me

  Else

     MsgBox "Alanlar Boş Bırakılamaz...!", vbInformation, "Hata!!"

  End If

End Sub

Private Sub TextBox1_Enter()

    TextBox1.BackColor = RGB(225, 190, 231)

End Sub

Private Sub TextBox1_AfterUpdate()

For i = 1 To 500

    A = Me.TextBox1.TextLength

    If LCase(Left(Sayfa2.Cells(i, "A"), A)) = Me.TextBox1 Or _

    UCase(Left(Sayfa2.Cells(i, "A"), A)) = Me.TextBox1 Then

    Me.TextBox1 = Sayfa2.Cells(i, "A")

End If

Next i
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    TextBox1.BackColor = vbWhite

    Dim k As Range, sat As Long

TextBox5.Text = ""

If TextBox1.Text = "" Then Exit Sub

With Sheets("data")

    sat = .Cells(Rows.Count, "A").End(xlUp).Row

    Set k = .Range("A1:A14" & sat).Find(TextBox1.Text, , xlValues, xlWhole)

    If Not k Is Nothing Then

        TextBox5.Text = k.Offset(0, 1).Value

        Else

        MsgBox TextBox1.Text & " Bulunamadi!!", vbCritical, "B U L U N A M A D I"

          Cancel = True

    End If

End With

Set k = Nothing

End Sub

Private Sub TextBox2_Enter()

    TextBox2.BackColor = RGB(225, 190, 231)

End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    TextBox2.BackColor = vbWhite

    TextBox2.Value = Date

    TextBox2 = Format(TextBox2, "dd.mm.yyyy")

End Sub

Private Sub TextBox3_Enter()

    TextBox3.BackColor = RGB(225, 190, 231)

End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    TextBox3.BackColor = vbWhite

End Sub

Private Sub TextBox4_Enter()

    TextBox4.BackColor = RGB(225, 190, 231)

End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    TextBox4.BackColor = vbWhite

End Sub

Private Sub TextBox3_Change()

    TextBox3 = Format(TextBox3, "#,#")

End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then

        KeyAscii = 0

        Beep

        MsgBox "Lot Sayısı Rakamsal Değer Olmalıdır..!", vbInformation, "Hata!!"

    End If

End Sub



Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If KeyAscii < 44 Or KeyAscii > 57 Then

        KeyAscii = 0

        Beep

        MsgBox "Hisse fiyatı Rakamsal Değer Olmalıdır..!", vbInformation, "Hata!!"

    End If

End Sub
Private Sub UserForm_Click()
End Sub
 
ALTIN üyeliği olmayan üyelerimiz harici dosya paylaşım sitelerine örnek dosyalarını (kişisel bilgi içermeyen) yükleyip forumda örnek dosyanın indirme linki paylaşarak destek talebinde bulunuyorlar.
 
Korhan Ayhan' Alıntı:
ALTIN üyeliği olmayan üyelerimiz harici dosya paylaşım sitelerine örnek dosyalarını (kişisel bilgi içermeyen) yükleyip forumda örnek dosyanın indirme linki paylaşarak destek talebinde bulunuyorlar.
Genişletmek için tıkla ...
Hocam bugün zaman bulunca ''Altın Üyelik'' alacağım. o zaman dosya yükeleyeceğim
 
Paylaştığınız dosyada DATA sayfasında kullandığınız fonksiyon bende çalışmadı. Belki bu fonksiyon yavaşlığa sebep oluyordur.
 
Korhan Ayhan' Alıntı:
Paylaştığınız dosyada DATA sayfasında kullandığınız fonksiyon bende çalışmadı. Belki bu fonksiyon yavaşlığa sebep oluyordur.
Genişletmek için tıkla ...
Hoca "Data" sayfası başka bir programdan veri çekiyor siz de olmadığı için hata verdi galiba.. simdi değiştirdim rica etsem tekrar bakabilir misiniz?

disk.yandex.com.tr

Hisselerim_Guncel.xlsm

Görüntüle ve Yandex Disk'ten indir
disk.yandex.com.tr disk.yandex.com.tr
 
#11 nolu mesajda belirttiğim gibi dosyanıza textbox ve listboxla süzme işlemini uyarladım. İnceleyiniz:

Hisselerim_Guncel.xlsm

drive.google.com drive.google.com
 
YUSUF44' Alıntı:
#11 nolu mesajda belirttiğim gibi dosyanıza textbox ve listboxla süzme işlemini uyarladım. İnceleyiniz:

Hisselerim_Guncel.xlsm

drive.google.com drive.google.com
Genişletmek için tıkla ...

Hocam çok çok teşekkür ederim. Bu daha çok hoşuma gitti sağolun. Ama bir sorum daha olacak, textbox5 deki değer data sayfasından çekiyor ve o sayfadaki hisse fiyatları canlı olduğu için sürekli değişiyor bendeki textbox5 deki değer sabit kalıyor. Yarın seans içi deneyeceğim şimdi imkan yok. Kısaca ben data sayfasındaki b hücresinden Textbox5 e çekilen fiyatın canlı olmasını istemiştim. Size tekrar çok teşekkür ediyorum
 
Canlı veri değişimleriyle çok ilgilenmedim ama eğer imkan varsa o güncellemeyi yapan makroya tetxtbox5’i de değiştirme kodu eklenebilir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst