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

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...
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
yokmu arkadaslar yardım edebılıcek?
 
Zeki Gürsoy

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Ekli dosyayı inceleyin.

Veri doğrulama kaynağında "dinamik alan" tekniği kullanıldı.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
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
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
ellerinize sayglık sn Ferhat bey ve sn Zeki bey.
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
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
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
hocam hizir acil servis gibisin
tesekkurler tekrar.
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
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?
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
:) bir baska soruda gorusmek uzere... her zamanki gibi tam kivaminda tam istendigi gibi.


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

kolay gelsin
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
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?
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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:
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
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
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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:
 
E

edkaya

Katılım
12 Şubat 2008
Mesajlar
112
Excel Vers. ve Dili
Evde:Office 2010 Ingilizce
İşte: Office 2010 Ingilizce
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
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Üst