Döngü oluşturma ve satır kaydı...

[hyilmaz076]

ekteki örnekteki form'da satırları oluşturan comboboxlar var 1.satır (combobox1..2..3..4) 2.satır (combobox5..6..7..8) 3.satır (combobox9..10..11..12) gibi dizili kaydet butonu ile önce sayfa1'in 2.satırından başlayarak kaydetmesi için bir makro oluşturdum sonra aşağıdaki gibi bir döngüden yararlanmaya çalıştım ama bu döngüyü sanırım doğru kuramadım, amacım satırları kaydettirmek ve ikinci bir form kaydını sağlamak istediğimde kaldığı satırdan başlamasını sağlamaktı...
(Bu arada kimse kızmadan belirteyim) Ara yaparak neredeyse çıkan tüm bölümleri inceliyorum... yinede teşekkür ederim

 

[hyilmaz076]

Arkadaşlar burada şötle bir döngü kullandım ilk kayıt ekranını tamamlıyor ama ikinci kayıt ekranını açtığımda hata veriyor sanırım fazla satır var...
Private Sub KaydetButon_Click()
Dim s1 As Integer
Dim s2 As Integer
Dim s3 As Integer

For s1 = 1 To 4

If ComboBox1.Text = "" Or ComboBox2.Text = "" Then
MsgBox "Adı ve Soyadı boş geçilemez", vbOKOnly
Else

s1 = Application.CountA(Sheets("Sayfa1").Columns("A")) + 1

sira = TextBox1.Text

Sheets("Sayfa1").Cells(s1, 2) = ComboBox1.Text
Sheets("Sayfa1").Cells(s1, 3) = ComboBox2.Text
Sheets("Sayfa1").Cells(s1, 4) = ComboBox3.Text
Sheets("Sayfa1").Cells(s1, 5) = ComboBox4.Text
Sheets("Sayfa1").Cells(s1, 1) = TextBox1.Text
End If
Next s1

For s2 = 1 To 4

Sheets("Sayfa1").Cells(s1, 2) = ComboBox5.Text
Sheets("Sayfa1").Cells(s1, 3) = ComboBox6.Text
Sheets("Sayfa1").Cells(s1, 4) = ComboBox7.Text
Sheets("Sayfa1").Cells(s1, 5) = ComboBox8.Text
Sheets("Sayfa1").Cells(s1, 1) = TextBox1.Text

Next s2

For s3 = 1 To 4

Sheets("Sayfa1").Cells(s1, 2) = ComboBox9.Text
Sheets("Sayfa1").Cells(s1, 3) = ComboBox10.Text
Sheets("Sayfa1").Cells(s1, 4) = ComboBox11.Text
Sheets("Sayfa1").Cells(s1, 5) = ComboBox12.Text
Sheets("Sayfa1").Cells(s1, 1) = TextBox1.Text
TextBox1.Text = sira + 1
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
ComboBox4.Text = ""

Next s3

End Sub

 

[hyilmaz076]

Baktımki kurmaya çalıştığım döngüye yardımeli uzanmadı bende döngüsüz yaptım, ama çalıştı
Yanlız küçük bir sorun var onu bulmaya çalışıyorum, boş kayıt engellemem lazım...

If ComboBox1.Text = "" Or ComboBox2.Text = "" Then
MsgBox "Adı ve Soyadı boş geçilemez", vbOKOnly
Else
x = Application.CountA(Sheets("Sayfa1").Columns("A")) + 1

sira = TextBox1.Text

Sheets("Sayfa1").Cells(x, 2) = ComboBox1.Text
Sheets("Sayfa1").Cells(x, 3) = ComboBox2.Text
Sheets("Sayfa1").Cells(x, 4) = ComboBox3.Text
Sheets("Sayfa1").Cells(x, 5) = ComboBox4.Text
Sheets("Sayfa1").Cells(x, 1) = TextBox1.Text
Sheets("Sayfa1").Cells(x + 1, 2) = ComboBox5.Text
Sheets("Sayfa1").Cells(x + 1, 3) = ComboBox6.Text
Sheets("Sayfa1").Cells(x + 1, 4) = ComboBox7.Text
Sheets("Sayfa1").Cells(x + 1, 5) = ComboBox8.Text
Sheets("Sayfa1").Cells(x + 1, 1) = TextBox1.Text
Sheets("Sayfa1").Cells(x + 2, 2) = ComboBox9.Text
Sheets("Sayfa1").Cells(x + 2, 3) = ComboBox10.Text
Sheets("Sayfa1").Cells(x + 2, 4) = ComboBox11.Text
Sheets("Sayfa1").Cells(x + 2, 5) = ComboBox12.Text
Sheets("Sayfa1").Cells(x + 2, 1) = TextBox1.Text
End If

 

[Levent Menteşoğlu]

Kaydet butonuna aşağıdaki kodu yazarak deneyin. Sıra nosu için textboxtaki değer kullanılmamıştır. Otomatik olarak verilmektedir.

[vb:1:03839ace2b]
Private Sub KaydetButon_Click()
For b = 1 To 12
If Controls("combobox" & b).Value = "" Then
MsgBox "HİÇ BİR VERİ GİRİÃžİ BOÞ GEÇİLEMEZ"
Controls("combobox" & b).SetFocus
Exit Sub
End If
Next
sat = WorksheetFunction.CountA([b1:b65536]) + 1
For a = 1 To 12
If a Mod 4 = 1 And a > 1 Then c = c + 1
Cells(sat + c, 1) = sat + c - 1
Cells(sat + c, a + 1 - c * 4) = Controls("combobox" & a).Value
Next
End Sub
[/vb:1:03839ace2b]