- Katılım
- 25 Aralık 2007
- Mesajlar
- 335
- Excel Vers. ve Dili
- exel 2000 türkçe
arkadaslPrivate Sub CommandButton54_Click()
Dim sat As Long, k As Range
If TextBox1.Value = "" Then
MsgBox "Kod boş olamaz..!!", vbCritical, "DİKKAT"
Exit Sub
End If
Set k = Sheets("KODLAR").Range("B2:B65536").Find(TextBox1.Value, , xlValues, xlWhole)
If k Is Nothing Then
sat = Sheets("KODLAR").Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65534 Then
MsgBox "Satır doldu..!!" & vbLf & "Yeni kayıt yapamazsınız..!!", vbCritical, "SATIR DOLDU"
Exit Sub
End If
With Sheets("KODLAR")
.Cells(sat, "B").Value = TextBox1.Value
.Cells(sat, "b").Value = TextBox2.Value
.Cells(sat, "b").Value = TextBox3.Value
.Cells(sat, "b").Value = TextBox4.Value
.Cells(sat, "b").Value = TextBox5.Value
.Cells(sat, "b").Value = TextBox6.Value
.Cells(sat, "b").Value = TextBox7.Value
.Cells(sat, "b").Value = TextBox8.Value
.Cells(sat, "b").Value = TextBox9.Value
.Cells(sat, "b").Value = TextBox10.Value
.Cells(sat, "b").Value = TextBox11.Value
.Cells(sat, "b").Value = TextBox12.Value
.Cells(sat, "b").Value = TextBox13.Value
.Cells(sat, "b").Value = TextBox14.Value
.Cells(sat, "b").Value = TextBox15.Value
.Cells(sat, "b").Value = TextBox16.Value
.Cells(sat, "b").Value = TextBox17.Value
.Cells(sat, "b").Value = TextBox18.Value
.Cells(sat, "b").Value = TextBox19.Value
.Cells(sat, "b").Value = TextBox20.Value
.Cells(sat, "b").Value = TextBox21.Value
.Cells(sat, "b").Value = TextBox22.Value
.Cells(sat, "b").Value = TextBox23.Value
.Cells(sat, "b").Value = TextBox24.Value
.Cells(sat, "b").Value = TextBox25.Value
.Cells(sat, "b").Value = TextBox26.Value
.Cells(sat, "b").Value = TextBox27.Value
.Cells(sat, "b").Value = TextBox28.Value
.Cells(sat, "b").Value = TextBox29.Value
.Cells(sat, "b").Value = TextBox30.Value
.Cells(sat, "b").Value = TextBox31.Value
.Cells(sat, "b").Value = TextBox32.Value
.Cells(sat, "b").Value = TextBox33.Value
.Cells(sat, "b").Value = TextBox34.Value
.Cells(sat, "b").Value = TextBox35.Value
.Cells(sat, "b").Value = TextBox36.Value
.Cells(sat, "b").Value = TextBox37.Value
.Cells(sat, "b").Value = TextBox38.Value
.Cells(sat, "b").Value = TextBox39.Value
End With
Else
If MsgBox("KOD : " & TextBox1.Value & " Daha önceden girilmiş..!!" & vbLf _
& "Üstüne Kaydetmek istiyormusunuz??", vbYesNo + vbQuestion, "DİKKAT") = vbNo Then
Exit Sub
End If
With Sheets("KODLAR")
.Cells(k.Row, "b").Value = TextBox2.Value
.Cells(k.Row, "b").Value = TextBox3.Value
.Cells(k.Row, "b").Value = TextBox4.Value
.Cells(k.Row, "b").Value = TextBox5.Value
.Cells(k.Row, "b").Value = TextBox6.Value
.Cells(k.Row, "b").Value = TextBox7.Value
.Cells(k.Row, "b").Value = TextBox8.Value
.Cells(k.Row, "b").Value = TextBox9.Value
.Cells(k.Row, "b").Value = TextBox10.Value
.Cells(k.Row, "b").Value = TextBox11.Value
.Cells(k.Row, "b").Value = TextBox12.Value
.Cells(k.Row, "b").Value = TextBox13.Value
.Cells(k.Row, "b").Value = TextBox14.Value
.Cells(k.Row, "b").Value = TextBox15.Value
.Cells(k.Row, "b").Value = TextBox16.Value
.Cells(k.Row, "b").Value = TextBox17.Value
.Cells(k.Row, "b").Value = TextBox18.Value
.Cells(k.Row, "b").Value = TextBox19.Value
.Cells(k.Row, "b").Value = TextBox20.Value
.Cells(k.Row, "b").Value = TextBox21.Value
.Cells(k.Row, "b").Value = TextBox22.Value
.Cells(k.Row, "b").Value = TextBox23.Value
.Cells(k.Row, "b").Value = TextBox24.Value
.Cells(k.Row, "b").Value = TextBox25.Value
.Cells(k.Row, "b").Value = TextBox26.Value
.Cells(k.Row, "b").Value = TextBox27.Value
.Cells(k.Row, "b").Value = TextBox28.Value
.Cells(k.Row, "b").Value = TextBox29.Value
.Cells(k.Row, "b").Value = TextBox30.Value
.Cells(k.Row, "b").Value = TextBox31.Value
.Cells(k.Row, "b").Value = TextBox32.Value
.Cells(k.Row, "b").Value = TextBox33.Value
.Cells(k.Row, "b").Value = TextBox34.Value
.Cells(k.Row, "b").Value = TextBox35.Value
.Cells(k.Row, "b").Value = TextBox36.Value
.Cells(k.Row, "b").Value = TextBox37.Value
.Cells(k.Row, "b").Value = TextBox38.Value
.Cells(k.Row, "b").Value = TextBox39.Value
End With
End If
MsgBox "Kayıt Girildi..!!", vbOKOnly + vbInformation, "KAYIT"
End Subar
bu kodu nasıl degiştirmeliyim ki butun textboxları sırasını sasırmadan aynı sutuna kopyalasın
birde bu textboxlar sadece 1 sutuna ait ve bunun gibi altı sutun daha var koplayanacak bundan bi sorun cıkarmı
Dim sat As Long, k As Range
If TextBox1.Value = "" Then
MsgBox "Kod boş olamaz..!!", vbCritical, "DİKKAT"
Exit Sub
End If
Set k = Sheets("KODLAR").Range("B2:B65536").Find(TextBox1.Value, , xlValues, xlWhole)
If k Is Nothing Then
sat = Sheets("KODLAR").Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65534 Then
MsgBox "Satır doldu..!!" & vbLf & "Yeni kayıt yapamazsınız..!!", vbCritical, "SATIR DOLDU"
Exit Sub
End If
With Sheets("KODLAR")
.Cells(sat, "B").Value = TextBox1.Value
.Cells(sat, "b").Value = TextBox2.Value
.Cells(sat, "b").Value = TextBox3.Value
.Cells(sat, "b").Value = TextBox4.Value
.Cells(sat, "b").Value = TextBox5.Value
.Cells(sat, "b").Value = TextBox6.Value
.Cells(sat, "b").Value = TextBox7.Value
.Cells(sat, "b").Value = TextBox8.Value
.Cells(sat, "b").Value = TextBox9.Value
.Cells(sat, "b").Value = TextBox10.Value
.Cells(sat, "b").Value = TextBox11.Value
.Cells(sat, "b").Value = TextBox12.Value
.Cells(sat, "b").Value = TextBox13.Value
.Cells(sat, "b").Value = TextBox14.Value
.Cells(sat, "b").Value = TextBox15.Value
.Cells(sat, "b").Value = TextBox16.Value
.Cells(sat, "b").Value = TextBox17.Value
.Cells(sat, "b").Value = TextBox18.Value
.Cells(sat, "b").Value = TextBox19.Value
.Cells(sat, "b").Value = TextBox20.Value
.Cells(sat, "b").Value = TextBox21.Value
.Cells(sat, "b").Value = TextBox22.Value
.Cells(sat, "b").Value = TextBox23.Value
.Cells(sat, "b").Value = TextBox24.Value
.Cells(sat, "b").Value = TextBox25.Value
.Cells(sat, "b").Value = TextBox26.Value
.Cells(sat, "b").Value = TextBox27.Value
.Cells(sat, "b").Value = TextBox28.Value
.Cells(sat, "b").Value = TextBox29.Value
.Cells(sat, "b").Value = TextBox30.Value
.Cells(sat, "b").Value = TextBox31.Value
.Cells(sat, "b").Value = TextBox32.Value
.Cells(sat, "b").Value = TextBox33.Value
.Cells(sat, "b").Value = TextBox34.Value
.Cells(sat, "b").Value = TextBox35.Value
.Cells(sat, "b").Value = TextBox36.Value
.Cells(sat, "b").Value = TextBox37.Value
.Cells(sat, "b").Value = TextBox38.Value
.Cells(sat, "b").Value = TextBox39.Value
End With
Else
If MsgBox("KOD : " & TextBox1.Value & " Daha önceden girilmiş..!!" & vbLf _
& "Üstüne Kaydetmek istiyormusunuz??", vbYesNo + vbQuestion, "DİKKAT") = vbNo Then
Exit Sub
End If
With Sheets("KODLAR")
.Cells(k.Row, "b").Value = TextBox2.Value
.Cells(k.Row, "b").Value = TextBox3.Value
.Cells(k.Row, "b").Value = TextBox4.Value
.Cells(k.Row, "b").Value = TextBox5.Value
.Cells(k.Row, "b").Value = TextBox6.Value
.Cells(k.Row, "b").Value = TextBox7.Value
.Cells(k.Row, "b").Value = TextBox8.Value
.Cells(k.Row, "b").Value = TextBox9.Value
.Cells(k.Row, "b").Value = TextBox10.Value
.Cells(k.Row, "b").Value = TextBox11.Value
.Cells(k.Row, "b").Value = TextBox12.Value
.Cells(k.Row, "b").Value = TextBox13.Value
.Cells(k.Row, "b").Value = TextBox14.Value
.Cells(k.Row, "b").Value = TextBox15.Value
.Cells(k.Row, "b").Value = TextBox16.Value
.Cells(k.Row, "b").Value = TextBox17.Value
.Cells(k.Row, "b").Value = TextBox18.Value
.Cells(k.Row, "b").Value = TextBox19.Value
.Cells(k.Row, "b").Value = TextBox20.Value
.Cells(k.Row, "b").Value = TextBox21.Value
.Cells(k.Row, "b").Value = TextBox22.Value
.Cells(k.Row, "b").Value = TextBox23.Value
.Cells(k.Row, "b").Value = TextBox24.Value
.Cells(k.Row, "b").Value = TextBox25.Value
.Cells(k.Row, "b").Value = TextBox26.Value
.Cells(k.Row, "b").Value = TextBox27.Value
.Cells(k.Row, "b").Value = TextBox28.Value
.Cells(k.Row, "b").Value = TextBox29.Value
.Cells(k.Row, "b").Value = TextBox30.Value
.Cells(k.Row, "b").Value = TextBox31.Value
.Cells(k.Row, "b").Value = TextBox32.Value
.Cells(k.Row, "b").Value = TextBox33.Value
.Cells(k.Row, "b").Value = TextBox34.Value
.Cells(k.Row, "b").Value = TextBox35.Value
.Cells(k.Row, "b").Value = TextBox36.Value
.Cells(k.Row, "b").Value = TextBox37.Value
.Cells(k.Row, "b").Value = TextBox38.Value
.Cells(k.Row, "b").Value = TextBox39.Value
End With
End If
MsgBox "Kayıt Girildi..!!", vbOKOnly + vbInformation, "KAYIT"
End Subar
bu kodu nasıl degiştirmeliyim ki butun textboxları sırasını sasırmadan aynı sutuna kopyalasın
birde bu textboxlar sadece 1 sutuna ait ve bunun gibi altı sutun daha var koplayanacak bundan bi sorun cıkarmı