• DİKKAT

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

Aynı id'lerin altına ekleme

balanar

Altın Üye
Katılım
22 Şubat 2021
Mesajlar
348
Excel Vers. ve Dili
Excel 2007
Merhaba, ekte eklediğim dosyada kayıt girişi yapıldıktan sonra alttaki boş satıra veri ekliyor.

Benim burada yapmak istediğim ID'si 62 Recep Tokgöz olarak ekleyince direk aynı kişi olanın altına eklenmesini istiyorum yardımcı olabilirseniz sevinirim
 

Ekli dosyalar

Merhaba, isim ve soyisim tek hücrede olduğu için Form üzerinde Label isimlerini resimdeki gibi değiştiriniz.
228687

Kaydet kodlarını da aşağıdaki kodlar ile değiştiriniz.
Dikkat etmeniz gereken husus, isim ve soyisime göre arama yapıldığı için Aynı İsimli Farklı kişiler varsa, onların kayıtlarında yanlışlık olur.

Kod:
Private Sub CommandButton1_Click()
Dim s1 As Worksheet, SonSatir As Integer
Dim aranan As String, say As Long, satir As Long
Set s1 = Sheets("Sayfa1")

aranan = Trim(TextBox2.Text)
say = WorksheetFunction.CountIf(s1.Range("B1:B" & Rows.Count), aranan)

If say > 0 Then
    satir = s1.Range("B:B").Find(aranan).Row
    s1.Rows(satir + say).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    TextBox1_ID.Value = _
        s1.Range("B2:B" & Rows.Count).Find(aranan).Offset(0, -1).Value
    
    s1.Cells(satir + say, 1) = TextBox1_ID.Value
    s1.Cells(satir + say, 2) = Trim(TextBox2.Text)
    s1.Cells(satir + say, 3) = TextBox3.Value
    s1.Cells(satir + say, 4) = CDate(TextBox4.Value)
    s1.Cells(satir + say, 5) = CDate(TextBox5.Value)
    s1.Cells(satir + say, 6) = TextBox6.Value
Else

    SonSatir = WorksheetFunction.CountA(s1.Range("A:A")) + 1
    s1.Cells(SonSatir, 1) = SonSatir - 1
    s1.Cells(SonSatir, 2) = Trim(TextBox2.Text)
    s1.Cells(SonSatir, 3) = TextBox3.Value
    s1.Cells(SonSatir, 4) = CDate(TextBox4.Value)
    s1.Cells(SonSatir, 5) = CDate(TextBox5.Value)
    s1.Cells(SonSatir, 6) = TextBox6.Value

End If

Set s1 = Nothing: aranan = ""
say = 0: satir = 0: SonSatir = 0
End Sub
 
Merhaba, isim ve soyisim tek hücrede olduğu için Form üzerinde Label isimlerini resimdeki gibi değiştiriniz.
Ekli dosyayı görüntüle 228687

Kaydet kodlarını da aşağıdaki kodlar ile değiştiriniz.
Dikkat etmeniz gereken husus, isim ve soyisime göre arama yapıldığı için Aynı İsimli Farklı kişiler varsa, onların kayıtlarında yanlışlık olur.

Kod:
Private Sub CommandButton1_Click()
Dim s1 As Worksheet, SonSatir As Integer
Dim aranan As String, say As Long, satir As Long
Set s1 = Sheets("Sayfa1")

aranan = Trim(TextBox2.Text)
say = WorksheetFunction.CountIf(s1.Range("B1:B" & Rows.Count), aranan)

If say > 0 Then
    satir = s1.Range("B:B").Find(aranan).Row
    s1.Rows(satir + say).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
    TextBox1_ID.Value = _
        s1.Range("B2:B" & Rows.Count).Find(aranan).Offset(0, -1).Value
   
    s1.Cells(satir + say, 1) = TextBox1_ID.Value
    s1.Cells(satir + say, 2) = Trim(TextBox2.Text)
    s1.Cells(satir + say, 3) = TextBox3.Value
    s1.Cells(satir + say, 4) = CDate(TextBox4.Value)
    s1.Cells(satir + say, 5) = CDate(TextBox5.Value)
    s1.Cells(satir + say, 6) = TextBox6.Value
Else

    SonSatir = WorksheetFunction.CountA(s1.Range("A:A")) + 1
    s1.Cells(SonSatir, 1) = SonSatir - 1
    s1.Cells(SonSatir, 2) = Trim(TextBox2.Text)
    s1.Cells(SonSatir, 3) = TextBox3.Value
    s1.Cells(SonSatir, 4) = CDate(TextBox4.Value)
    s1.Cells(SonSatir, 5) = CDate(TextBox5.Value)
    s1.Cells(SonSatir, 6) = TextBox6.Value

End If

Set s1 = Nothing: aranan = ""
say = 0: satir = 0: SonSatir = 0
End Sub

Değerli hocam tam istediğimiz gibi olmuş eklendiğinde ID'yide otomatik ekliyor ya, orada müdürlüğüde ekleyebilir mi otomatik?
 
Müdürlük bilgisi için s1.Cells(satir + say, 1) = TextBox1_ID.Value satırından önce aşağıdaki satırı ekleyiniz.
Kod:
    TextBox3.Value = _
        s1.Range("B2:B" & Rows.Count).Find(aranan).Offset(0, 1).Value
228690
 
Rica ederim. Saygılar.
 
Geri
Üst