• DİKKAT

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

Userform kayıt, veri dogrulama, dinamik liste... Yardım

  • Konbuyu başlatan Konbuyu başlatan edkaya
  • Başlangıç tarihi Başlangıç tarihi
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
sn ustalar
örnekte acıklamaya calıstım ama yapmak ıstedıgım sey mumkunmudur?

- DATA sayfasında dinamik tablo var
- Bilgi sayfasında veri dogrulama yapan liste ve bu liste uzerınde userform acılıp kayıt yap dedıgımızde ıkıncı sayfaya kayıt edip dinamik tabloya atması ve birinci sayfada veri dogrulamaya otomatik eklemesi...

yardımlarınızı bekliyorum...
 
yokmu arkadaslar yardım edebılıcek?
 
Ekli dosyayı inceleyin.

Veri doğrulama kaynağında "dinamik alan" tekniği kullanıldı.
 
Bilgi_1 adlı userforma aşağıdaki kodları kopyalayınız.

Kod: 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
Set bul = shD.Columns("C").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 3).End(xlUp).Row + 1, 3) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub

Userform1 adlı userformunuza ise aşağıdaki kodları kopyalayın.

Kod: 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
Set bul = shD.Columns("E").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 5).End(xlUp).Row + 1, 5) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_2", RefersTo:="=Data!$E$5:$E$" & shD.Cells(65536, 5).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub
 
ellerinize sayglık sn Ferhat bey ve sn Zeki bey.
 
Ferhat Pazarçevirdi' Alıntı:
Bilgi_1 adlı userforma aşağıdaki kodları kopyalayınız.

Kod: 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
Set bul = shD.Columns("C").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 3).End(xlUp).Row + 1, 3) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub

Userform1 adlı userformunuza ise aşağıdaki kodları kopyalayın.

Kod: 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
Set bul = shD.Columns("E").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 5).End(xlUp).Row + 1, 5) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_2", RefersTo:="=Data!$E$5:$E$" & shD.Cells(65536, 5).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub
Genişletmek için tıkla ...

Ferhat Bey,
elinize saglik fakat birsey daha sormak istiyordum
buraya hangi satiri eklemeliyiz ki. hucre bos ise kayit yapmasin. mukkerrer kayitlarda uyari versin. mukerrer icin uyari var fakat bos icin de bir yardim edebilirmisiniz
 
Aşağıdaki kırmızı satırları ilave ediniz.:cool:
Kod: 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
[COLOR="Red"][B]if textbox1.value="" then
   msgbox "Textbox1 Boş.İşlem Yapılmadı."
   textbox1.setfocus
   exit sub
end if[/B][/COLOR]
Set bul = shD.Columns("C").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 3).End(xlUp).Row + 1, 3) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End SubUserform1 adlı userformunuza ise aşağıdaki kodları kopyalayın.


Kod:
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
[COLOR="red"][B]if textbox1.value="" then
   msgbox "Textbox1 Boş.İşlem Yapılmadı."
   textbox1.setfocus
   exit sub
end if[/B][/COLOR]
Set bul = shD.Columns("E").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
    shD.Cells(shD.Cells(65536, 5).End(xlUp).Row + 1, 5) = TextBox1
    ThisWorkbook.Names.Add Name:="Bilgi_2", RefersTo:="=Data!$E$5:$E$" & shD.Cells(65536, 5).End(xlUp).Row
Else
    MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub
 
hocam hizir acil servis gibisin
tesekkurler tekrar.
 
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
if textbox1.value="" then
msgbox "Textbox1 Boş.İşlem Yapılmadı."
textbox1.setfocus
exit sub
end if
Set bul = shD.Columns("C").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
shD.Cells(shD.Cells(65536, 3).End(xlUp).Row + 1, 3) = TextBox1
ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row
Else
MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub


bu kodlar data sayfasinda C stununa veri kaydediyor. kirmiziyla boyadigim yerleri A yapmama ragmen hala C ye kayit ediyor/ baska nereleri degistirmem gerek A stununa kayit yapmasi icin Data sayfasinda?
 
Aşağıda Yeşil boyalı yeri değiştiriniz.:cool:
Private Sub CommandButton1_Click()
Dim shL As Worksheet
Dim shD As Worksheet
Set shL = Sheets("Liste")
Set shD = Sheets("Data")
if textbox1.value="" then
msgbox "Textbox1 Boş.İşlem Yapılmadı."
textbox1.setfocus
exit sub
end if
Set bul = shD.Columns("C").Find(TextBox1, lookat:=xlWhole)
If bul Is Nothing Then
shD.Cells(shD.Cells(65536, 3).End(xlUp).Row + 1, "A") = TextBox1
ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row
Else
MsgBox "Aynı isimde bir veri zaten var", vbCritical, "UYARI"
End If
Set bul = Nothing
Set shL = Nothing
Set shD = Nothing
Unload Me
End Sub
 
:) bir baska soruda gorusmek uzere... her zamanki gibi tam kivaminda tam istendigi gibi.


baska soru yakin zamanda cikacak ama :):):)

kolay gelsin
 
edkaya' Alıntı:
:) bir baska soruda gorusmek uzere... her zamanki gibi tam kivaminda tam istendigi gibi.


baska soru yakin zamanda cikacak ama :):):)

kolay gelsin
Genişletmek için tıkla ...

Aşağıdaki satırı değiştirin şimdi farkına vardım.:cool:
Kod: 
shD.Cells(shD.Cells(65536, [COLOR="Red"][B]"A"[/B][/COLOR]).End(xlUp).Row + 1, "A") = TextBox1
 
ekstradan bunuda mi degistirmem gerek?
tamam birde bunu degistirip deniyorum

;)

ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row


peki bu usttek' satirda kirmizi yeride "A" ile degistirmem gerekecekmi?
 
edkaya' Alıntı:
ekstradan bunuda mi degistirmem gerek?
tamam birde bunu degistirip deniyorum

;)

ThisWorkbook.Names.Add Name:="Bilgi_1", RefersTo:="=Data!$C$5:$C$" & shD.Cells(65536, 3).End(xlUp).Row


peki bu usttek' satirda kirmizi yeride "A" ile degistirmem gerekecekmi?
Genişletmek için tıkla ...
O satırda "Bilgi_1" isimli ad tanımlaması yapılmış.Sayfada o tanımlı alan bir şekilde kullanılıyor olabilir.Onu bilemem.Şimdilik değiştirmeyin,derim.:cool:
 
Evren Gizlen' Alıntı:
O satırda "Bilgi_1" isimli ad tanımlaması yapılmış.Sayfada o tanımlı alan bir şekilde kullanılıyor olabilir.Onu bilemem.Şimdilik değiştirmeyin,derim.:cool:
Genişletmek için tıkla ...

o tanimlama degil
userform adi

o yuzden oyle yazmis Ferhat bey sanirim
 
edkaya' Alıntı:
o tanimlama degil
userform adi

o yuzden oyle yazmis Ferhat bey sanirim
Genişletmek için tıkla ...

Userform adı olabilir ama kodlarda gözüken ad tanımlaması yapılmış.Kodu çalıştırdıktan sonra Çalışma sayafasını açıp ad tanımlamalarına bakınız.:cool:
C sütununuda referans almış.:cool:
 
Evren Gizlen' Alıntı:
Userform adı olabilir ama kodlarda gözüken ad tanımlaması yapılmış.Kodu çalıştırdıktan sonra Çalışma sayafasını açıp ad tanımlamalarına bakınız.:cool:
C sütununuda referans almış.:cool:
Genişletmek için tıkla ...

neyse ustalar yapti nede olsa vardir bi bildikleri. bu haliyle calisiyor nede olsa. o yuzden bi SIKINTI yok simdilik.

tekrar elinize kolunuza saglik
gorusmek uzere
 
edkaya' Alıntı:
neyse ustalar yapti nede olsa vardir bi bildikleri. bu haliyle calisiyor nede olsa. o yuzden bi SIKINTI yok simdilik.

tekrar elinize kolunuza saglik
gorusmek uzere
Genişletmek için tıkla ...
İyi akşamlar.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst