Aynı id'lerin altına ekleme

[balanar]

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

 

[AdemCan]

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


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.

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

 

[balanar]

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.

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?

 

[AdemCan]

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.

    TextBox3.Value = _
        s1.Range("B2:B" & Rows.Count).Find(aranan).Offset(0, 1).Value

 

[balanar]

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.

    TextBox3.Value = _
        s1.Range("B2:B" & Rows.Count).Find(aranan).Offset(0, 1).Value

Ekli dosyayı görüntüle 228690

Çok teşekkürler hocam

 

[AdemCan]

Rica ederim. Saygılar.