kaydet kodunu kısaltma

[yalovam77]

SELAMLAR üstadlar buradaki verdiğiniz bilgi ve yardımlar için teşekkür ederim sizlerden aldığım bilgilerle form oluşturdum ancak aşağıdaki kaydet kodunu kısa bir şekilde yazmak mümkünmü, mümkünse kısaltılmış halini yazarmısınız şimdiden ilginize teşekkür ederim.

Private Sub cmdkaydet_Click()
If TextBox1.Text <> "" Then

For I = 2 To Sheets("personel").Range("A500").End(xlUp).Row
If UCase(Sheets("personel").Range("B" & I).Value) = UCase(TextBox1.Text) Then

MsgBox "Bu isimde bir kişi zaten kayıtlarda var", vbCritical, "MÜKERRER KAYIT BULUNDU"
Exit Sub
End If
Next I

Son_Dolu_Satir = Sheets("Personel").Range("A500").End(xlUp).Row

Bos_Satir = Son_Dolu_Satir + 1

Sheets("Personel").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Personel").Range("A:A")) + 1

Sheets("Personel").Range("B" & Bos_Satir).Value = TextBox1.Text
Sheets("Personel").Range("C" & Bos_Satir).Value = TextBox2.Text
Sheets("Personel").Range("D" & Bos_Satir).Value = TextBox3.Text
Sheets("Personel").Range("E" & Bos_Satir).Value = TextBox4.Text
Sheets("Personel").Range("F" & Bos_Satir).Value = TextBox5.Text
Sheets("Personel").Range("G" & Bos_Satir).Value = TextBox6.Text
Sheets("Personel").Range("H" & Bos_Satir).Value = TextBox7.Text
Sheets("Personel").Range("I" & Bos_Satir).Value = TextBox8.Text
Sheets("Personel").Range("J" & Bos_Satir).Value = TextBox9.Text
Sheets("Personel").Range("K" & Bos_Satir).Value = TextBox10.Text
Sheets("Personel").Range("L" & Bos_Satir).Value = TextBox11.Text
Sheets("Personel").Range("M" & Bos_Satir).Value = TextBox12.Text
Sheets("Personel").Range("N" & Bos_Satir).Value = TextBox13.Text
Sheets("Personel").Range("O" & Bos_Satir).Value = TextBox14.Text
Sheets("Personel").Range("P" & Bos_Satir).Value = TextBox15.Text
Sheets("Personel").Range("Q" & Bos_Satir).Value = TextBox16.Text
Sheets("Personel").Range("R" & Bos_Satir).Value = TextBox17.Text
Sheets("Personel").Range("S" & Bos_Satir).Value = TextBox18.Text
Sheets("Personel").Range("T" & Bos_Satir).Value = TextBox19.Text
Sheets("Personel").Range("U" & Bos_Satir).Value = TextBox20.Text
Sheets("Personel").Range("V" & Bos_Satir).Value = TextBox21.Text
Sheets("Personel").Range("W" & Bos_Satir).Value = TextBox22.Text
Sheets("Personel").Range("X" & Bos_Satir).Value = TextBox23.Text
Sheets("Personel").Range("Y" & Bos_Satir).Value = TextBox24.Text
Sheets("Personel").Range("Z" & Bos_Satir).Value = TextBox25.Text
Sheets("Personel").Range("AA" & Bos_Satir).Value = TextBox26.Text

Else

MsgBox "İsim Girmeniz gerekiyor"

End If

If TextBox1.Text <> "" Then

ProgressBar1.Visible = True
Dim c As Integer
For c = 1 To 1000
ProgressBar1.Value = (c / 1000) * 100
Label10.Caption = Format(Int((c / 1000) * 100), "%0")
DoEvents
Next c

MsgBox "Kayıt Tamamlandı!!!"

ProgressBar1.Visible = False

End If
End Sub

 

[N.Ziya Hiçdurmaz]

Yanıt

Private Sub cmdkaydet_Click()
If TextBox1.Text <> "" Then
For I = 2 To Sheets("personel").Range("A500").End(xlUp).Row
If UCase(Sheets("personel").Range("B" & I).Value) = UCase(TextBox1.Text) Then
MsgBox "Bu isimde bir kişi zaten kayıtlarda var", vbCritical, "MÜKERRER KAYIT BULUNDU"
Exit Sub
End If
Next I
Son_Dolu_Satir = Sheets("Personel").Range("A500").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Personel").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Personel ").Range("A:A")) + 1

[COLOR="Blue"]S = 2
For SUT = 1 To 26
Sheets("Personel").Cells(Bos_Satir, S) = Controls("TEXTBOX" & SUT)
S = S + 1
Next[/COLOR]

Else
MsgBox "İsim Girmeniz gerekiyor"
End If
If TextBox1.Text <> "" Then
ProgressBar1.Visible = True
Dim c As Integer
For c = 1 To 1000
ProgressBar1.Value = (c / 1000) * 100
Label10.Caption = Format(Int((c / 1000) * 100), "%0")
DoEvents
Next c
MsgBox "Kayıt Tamamlandı!!!"
ProgressBar1.Visible = False
End If
End Sub