• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfa ve Satır kontrolü

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,701
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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.
 
Selam arkadaşlar,

Bu konuda yardımlarınızı bekliyorum.
 
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]
 
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
 
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]
 
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
 
"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 ....
 
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:
 
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]
 
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 ?
 
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.
 
Sn. leventm,

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

For a = 1 To Sheets.Count
Genişletmek için tıkla ...

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

For a=1 to 15

sheets("data" & a)..........
 
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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst