• DİKKAT

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

user form ile yapılan kayıtda aynı kişiye ait bilgileri toplasın

A

ayemenici

Katılım
14 Şubat 2005
Mesajlar
137
arkadaşlar ekte verdiğim dosyada ekle butonuna basınca açılan user form ile kişilerin almış oldukları ürünleri girmekteyiz. ancak sonradan aynı kişiye ilave yapmak istediğimizde boş satıra aynı kişiyi ilave ediyor ben eğer isim var ise mükerrer kaydetmeyip üzerine işlesin (toplasın) istiyorum mümkünmü ilginize şimdiden teşekkürler...
 

Ekli dosyalar

ayemenici' Alıntı:
arkadaşlar ekte verdiğim dosyada ekle butonuna basınca açılan user form ile kişilerin almış oldukları ürünleri girmekteyiz. ancak sonradan aynı kişiye ilave yapmak istediğimizde boş satıra aynı kişiyi ilave ediyor ben eğer isim var ise mükerrer kaydetmeyip üzerine işlesin (toplasın) istiyorum mümkünmü ilginize şimdiden teşekkürler...
Genişletmek için tıkla ...
Merhaba
Formunuzda 5-6 ve 7. butonlarda bulunan kodları aşağıdakilerle değiştirip deneyin.

Kod: 
Private Sub CommandButton5_Click()
ActiveSheet.Unprotect Password:="42"
      If ComboBox1.Text <> "" Then
Set s = [c5:c6].Find(What:=ComboBox1.Text, LookAT:=xlWhole)
If Not s Is Nothing Then GoTo d
Range("C5").Select
Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
Loop
If Range("C5").Value = "" Then
   Range("C5").Value = 1
   Range("C5").Select
End If
d:
If Not s Is Nothing Then Cells(s.Row, 3).Select
ActiveCell.Offset(0, -1).Value = TextBox32.Text
ActiveCell.Offset(0, 0).Value = ComboBox1.Text
n = 1
For a = 2 To 31
If Controls("TextBox" & a).Text <> "" Then
ActiveCell.Offset(0, n) = Controls("TextBox" & a).Text + ActiveCell.Offset(0, n)
End If
n = n + 2
Next
ActiveSheet.Protect Password:="42", DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgBox "İSİM GİRİNİZ.", vbInformation
End If
Unload Me
KAYIT.Show
End Sub

Kod: 
Private Sub CommandButton6_Click()
ActiveSheet.Unprotect Password:="42"
If İSİM.Text <> "" Then
Set s = [c11:c48].Find(What:=İSİM, LookAT:=xlWhole)
If Not s Is Nothing Then GoTo d
Range("c11").Select
Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
Loop
If Range("C11").Value = "" Then
   Range("C11").Value = 1
   Range("C11").Select
End If
d:
If Not s Is Nothing Then Cells(s.Row, 3).Select
ActiveCell.Offset(0, -1).Value = TextBox1.Text
ActiveCell.Offset(0, 0).Value = İSİM.Text
n = 1
For a = 2 To 31
If Controls("TextBox" & a).Text <> "" Then
ActiveCell.Offset(0, n) = Controls("TextBox" & a).Text + ActiveCell.Offset(0, n)
End If
n = n + 2
Next
ActiveSheet.Protect Password:="42", DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgBox "İSİM GİRİNİZ.", vbInformation
End If
Unload Me
KAYIT.Show
End Sub

Kod: 
 Private Sub CommandButton7_Click()
ActiveSheet.Unprotect Password:="42"
If ComboBox2.Text <> "" Then
Set s = [c53:c190].Find(What:=ComboBox2.Text, LookAT:=xlWhole)
If Not s Is Nothing Then GoTo d
Range("C53").Select
Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
Loop
If Range("C53").Value = "" Then
   Range("C53").Value = 1
   Range("C53").Select
End If
d:
If Not s Is Nothing Then Cells(s.Row, 3).Select
ActiveCell.Offset(0, -1).Value = TextBox33.Text
ActiveCell.Offset(0, 0).Value = ComboBox2.Text
n = 1
For a = 2 To 31
If Controls("TextBox" & a).Text <> "" Then
ActiveCell.Offset(0, n) = Controls("TextBox" & a).Text + ActiveCell.Offset(0, n)
End If
n = n + 2
Next
ActiveSheet.Protect Password:="42", DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgBox "İSİM GİRİNİZ.", vbInformation
  End If
Unload Me
KAYIT.Show
End Sub
 

Ekli dosyalar

Son düzenleme:
Husgvarna arkadaşım öncelikle ilgine teşekkür ederim,
vermiş olduğun kodu kullandım ilave konusunda gayet iyi çalışıyor ancak boş kalemlere yani daha önce değer girilmemiş ürünlere giriş yapılınca aşağıdaki kısımda hata veriyor

ActiveCell.Offset(0, n) = Controls("TextBox" & a).Text + ActiveCell.Offset(0, n)
uğraştım ama düzeltemedim
 
ayemenici' Alıntı:
Husgvarna arkadaşım öncelikle ilgine teşekkür ederim,
vermiş olduğun kodu kullandım ilave konusunda gayet iyi çalışıyor ancak boş kalemlere yani daha önce değer girilmemiş ürünlere giriş yapılınca aşağıdaki kısımda hata veriyor

ActiveCell.Offset(0, n) = Controls("TextBox" & a).Text + ActiveCell.Offset(0, n)
uğraştım ama düzeltemedim
Genişletmek için tıkla ...
Hangi butonda?
Eklediğim dosyadada hata verdimi?
 
Yukarıdaki kodlara ekleme yapıldı dosyanızda onları denermisiniz?
 
Husgvarn arkadaşım ilgine çok teşekkür ederim ilaveyi ekledim mükemmel çalıştı

birde user formda ürün karşısına toplam kısmına label ile o ürüne ait iaşe sayfasındaki genel toplam gelmekte
bunu, isim seçildiği zaman o isme ait miktar bilgileri gelecek şekilde yapabilirmiyiz?
 
ayemenici' Alıntı:
birde user formda ürün karşısına toplam kısmına label ile o ürüne ait iaşe sayfasındaki genel toplam gelmekte
bunu, isim seçildiği zaman o isme ait miktar bilgileri gelecek şekilde yapabilirmiyiz?
Genişletmek için tıkla ...

İlgili "Combobox" larda bulunan kodları aşadakilerle değiştirip deneyin.
Kod: 
Private Sub ComboBox1_Change()
TextBox32 = Sheets("data").Cells(ComboBox1.ListIndex + 36, 2)
If ComboBox1 <> "" Then
Set s = [c5:c6].Find(What:=ComboBox1.Text, LookAT:=xlWhole)
If Not s Is Nothing Then Cells(s.Row, 3).Select
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = ActiveCell.Offset(0, n).Text
n = n + 2
Next
End If
Label70.Caption = ActiveCell.Offset(0, n).Value
Label71.Caption = ActiveCell.Offset(0, n + 4).Value
Label72.Caption = ActiveCell.Offset(0, n + 5).Value
If ComboBox1.Text <> ActiveCell.Text Then
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = Empty
n = n + 2
Next
Label70.Caption = ""
Label71.Caption = ""
Label72.Caption = ""
End If
End Sub
'...............................................................................

Private Sub ComboBox2_Change()
TextBox33 = Sheets("data").Cells(ComboBox2.ListIndex + 76, 2)
If ComboBox2 <> "" Then
Set s = [c53:c190].Find(What:=ComboBox2.Text, LookAT:=xlWhole)
If Not s Is Nothing Then Cells(s.Row, 3).Select
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = ActiveCell.Offset(0, n).Text
n = n + 2
Next
End If
Label70.Caption = ActiveCell.Offset(0, n).Value
Label71.Caption = ActiveCell.Offset(0, n + 4).Value
Label72.Caption = ActiveCell.Offset(0, n + 5).Value
If ComboBox2.Text <> ActiveCell.Text Then
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = Empty
n = n + 2
Next
Label70.Caption = ""
Label71.Caption = ""
Label72.Caption = ""
End If
End Sub

'.......................................................................................

Private Sub İSİM_Change()
TextBox1 = Sheets("data").Cells(İSİM.ListIndex + 38, 2)
If İSİM <> "" Then
Set s = [c11:c48].Find(What:=İSİM.Text, LookAT:=xlWhole)
If Not s Is Nothing Then Cells(s.Row, 3).Select
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = ActiveCell.Offset(0, n).Text
n = n + 2
Next
End If
Label70.Caption = ActiveCell.Offset(0, n).Value
Label71.Caption = ActiveCell.Offset(0, n + 4).Value
Label72.Caption = ActiveCell.Offset(0, n + 5).Value
If İSİM.Text <> ActiveCell.Text Then
n = 1
For a = 37 To 66
Controls("Label" & a).Caption = Empty
n = n + 2
Next
Label70.Caption = ""
Label71.Caption = ""
Label72.Caption = ""
End If
End Sub
 
Son düzenleme:
arkadaşım çok teşekkürler verdiğin kodlar çalıştı....
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst