Sayfa ve Satır kontrolü

[Korhan Ayhan]

Selam arkadaşlar,

15 sayfalık dosyamda döngü oluşturmak istiyorum. Nasıl mı?

Tuşa bastığımda 15 sayfa içinde B sütunu boş olan ilk sayfadaki boş olan hücreyi seçecek eğer 15 sayfada dolu ise "KAYIT YAPAMAZSINIZ." uyarısı verecek.

 

[Korhan Ayhan]

Selam arkadaşlar,

Bu konuda yardımlarınızı bekliyorum.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:a2e63a476b]Sub git()
For a = 1 To Sheets.Count
say = WorksheetFunction.CountA(Sheets(a).Columns(2))
If say < 65536 Then
Sheets(a).Select
Sheets(a).Cells(say + 1, 2).Select
Exit Sub
End If
Next
Msgbox "TÜM SAYFALAR DOLUDUR"
End Sub[/vb:1:a2e63a476b]

 

[Korhan Ayhan]

Sn. leventm,

Vermiş olduğunuz kodlar işime yaradı fakat kendi kodlarımla birleştiremedim. Yardımlarınızı bekliyorum. Þuanda kullandığım kayıt kodları işleme bir sayfa dolana kadar devam ediyor. Sayfa dolduğunda bir sonraki sayfadan işleme devam etmesini sağlayamaz mıyız?

Kullandığım kodlar,

Private Sub CommandButton1_Click()
Sheets("ZİMMET1").Select
Range("B65536").End(xlUp).Select
For i = TextBox5.Text To TextBox6.Text
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0) = CDate(TextBox1.Text)
ActiveCell.Offset(0, 1) = TextBox2.Text
ActiveCell.Offset(0, 2) = TextBox3.Text
ActiveCell.Offset(0, 3) = i
ActiveCell.Offset(0, 4) = TextBox4.Text
ActiveCell.Offset(0, 5) = "EVET"

Next

SIRANO = WorksheetFunction.CountA(Sheets("ZİMMET1").[B2:B65536]) + 1
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]<>"""",ROW()-1,"""")"
Range("A2").Select
Selection.Copy
Range("A2:A" & SIRANO).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("B2:G65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal

Range("B2").Select
TextBox1 = Date
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox1.SetFocus
MsgBox ("Zimmet oluşturma işlemi başarıyla tamamlanmıştır."), vbInformation, "DİKKAT !"
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki şekilde deneyin.

[vb:1:6fb157a9a1]Private Sub CommandButton1_Click()
For a = 1 To Sheets.Count
say = WorksheetFunction.CountA(Sheets(a).Columns(2))
If say < 65536 Then
Sheets(a).Select
Range("B65536").End(xlUp).Select
For i = TextBox5.Text To TextBox6.Text
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0) = CDate(TextBox1.Text)
ActiveCell.Offset(0, 1) = TextBox2.Text
ActiveCell.Offset(0, 2) = TextBox3.Text
ActiveCell.Offset(0, 3) = i
ActiveCell.Offset(0, 4) = TextBox4.Text
ActiveCell.Offset(0, 5) = "EVET"
Next
SIRANO = WorksheetFunction.CountA(Sheets("ZİMMET1").[B2:B65536]) + 1
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]<>"""",ROW()-1,"""")"
Range("A2").Select
Selection.Copy
Range("A2:A" & SIRANO).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B2:G65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Range("B2").Select
TextBox1 = Date
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox1.SetFocus
MsgBox ("Zimmet oluşturma işlemi başarıyla tamamlanmıştır."), vbInformation, "DİKKAT !"
Exit Sub
End If
Next
MsgBox "TÜM SAYFALAR DOLUDUR"
End Sub
[/vb:1:6fb157a9a1]

 

[Korhan Ayhan]

Sn. leventm,

Kodu kısaltarak aşağıdaki şekilde uyguladım fakat hata verdi ve bir sonraki sayfaya geçişi yapmadı.

Private Sub CommandButton1_Click()
For a = 1 To Sheets.Count
say = WorksheetFunction.CountA(Sheets(a).Columns(1))
If say < 65536 Then
Sheets(a).Select
Range("A65536").End(xlUp).Select
For i = TextBox5.Text To TextBox6.Text
ActiveCell.Offset(1, 0).Select ' BU SATIRDA HATA VERDİ.
ActiveCell.Offset(0) = "=IF(RC[1]<>"""",ROW()-1,"""")"
ActiveCell.Offset(0, 1) = CDate(TextBox1.Text)
ActiveCell.Offset(0, 2) = TextBox2.Text
ActiveCell.Offset(0, 3) = TextBox3.Text
ActiveCell.Offset(0, 4) = i
ActiveCell.Offset(0, 5) = TextBox4.Text
ActiveCell.Offset(0, 6) = "EVET"
Next
Range("B2:G65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Range("B2").Select
TextBox1 = Date
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox1.SetFocus
MsgBox ("Zimmet oluşturma işlemi başarıyla tamamlanmıştır."), vbInformation, "DİKKAT !"
Exit Sub
End If
Next
MsgBox "TÜM SAYFALAR DOLUDUR"
End Sub

 

[Haluk]

"For i = TextBox5.Text To TextBox6.Text "

Tam olarak incelemedim ama; sanki burada .Text özelliği değil de .Value kullanılsa mı acaba diyorum ....

 

[Korhan Ayhan]

Sn. Haluk,

Sizin dediğiniz değişikliği yaptım. Ayrıca işlem sırasındaki sayfa geçiş işlemini çözüme ulaştıramadım. Yardımlarınızı bekliyorum. :yardim:

 

[Levent Menteşoğlu]

Birde aşağıdaki gibi deneyin.

[vb:1:1ea79ff275]Private Sub CommandButton1_Click()
For i = TextBox5.value * 1 To TextBox6.value * 1
For a = 1 To Sheets.Count
say = WorksheetFunction.CountA(Sheets(a).Columns(1))
If say < 65536 Then
Sheets(a).Select
GoTo 10
End If
Next
MsgBox "TÜM SAYFALAR DOLUDUR"
Exit sub
10 Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0) = "=IF(RC[1]<>"""",ROW()-1,"""")"
ActiveCell.Offset(0, 1) = CDate(TextBox1.Text)
ActiveCell.Offset(0, 2) = TextBox2.Text
ActiveCell.Offset(0, 3) = TextBox3.Text
ActiveCell.Offset(0, 4) = i
ActiveCell.Offset(0, 5) = TextBox4.Text
ActiveCell.Offset(0, 6) = "EVET"
Next
Range("B2:G65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Range("B2").Select
TextBox1 = Date
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox1.SetFocus
MsgBox ("Zimmet oluşturma işlemi başarıyla tamamlanmıştır."), vbInformation, "DİKKAT !"
End Sub
[/vb:1:1ea79ff275]

 

[Korhan Ayhan]

Sn. leventm,

Verdiğiniz kodları denedim fakat seri aralığına ne girersem gireyim sizin "For i = 5 To 8" aralığını işliyor satırlara. Ayrıca Textbox1 değerine 10 değerini vermişsiniz bu kısmı anlamadım ?

 

[Levent Menteşoğlu]

O değerleri sadece kodu denemek için vermiştim. Değiştirmeyi unutmuşum kusura bakmayın. Yukarıdaki kodda gerekli düzeltmeleri yaptım tekrar deneyin. Ben denedim doğru çalışıyor.

 

[Korhan Ayhan]

Sn. leventm,

Aşağıdaki kısımda sayfa isimlerini nasıl tanımlayabilirim.

For a = 1 To Sheets.Count

Bu bölümde For a = Sheets("Data1") To Sheets("Data15") gibi bir aralık vermek istiyorum.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

For a=1 to 15

sheets("data" & a)..........

 

[sunay77]

zimmet

arkadaşlar zimmet programım içinyardımlarınızı bekliyorum benim istedigim
ana sayfa üzerinde isimlerin altındaki sütüna birim adsedini yazdığım zaman o kişiye ait sayfaya sırasıyla kayıdın girmesi
ekte gönderdigim dosyayı incelerseniz sevinirim syg.