• DİKKAT

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

Checkbox'lar ile Koşullu artarak sayı sıralama

E

Ergün Güler

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Selam Arkadaşlar,
Ekteki örnek dosyamdaki Sayfa1'de Veri formu düğmesine tıklayınca çıkan bir userform'um var.
Userform'daki Commandbutton1'e tıkladığımda 2'satırdan başlayarak A ve B sütunlarına sırayla sayı yazılıyor.
checkbox'lar şeçildiği kadar bir sayının artarak yazılmasını, bir sayının ise yine bir öncekinin aynısının yazılmasını istiyorum.
Detayları örnek dosyamda izah ettim.
Yardımcı olabilirseniz sevinirim.
 

Ekli dosyalar

Checkboxlar her zaman sıraylamı işaretlenecektir. Örneğin sadece 3. checkbox işaretlenebilirmi? eğer işaretlenebilirse bu durumda yapılacak işlem nasıl olacaktır.
 
Levent Menteşoğlu' Alıntı:
Checkboxlar her zaman sıraylamı işaretlenecektir. Örneğin sadece 3. checkbox işaretlenebilirmi? eğer işaretlenebilirse bu durumda yapılacak işlem nasıl olacaktır.
Genişletmek için tıkla ...
Selam Sayın Levent Menteşoğlu,
Öncelikle ilginize çok teşekkür ederim. Evet her zaman sırayla işaretlenecektir. Ya hiçbiri, 1 veya 1,2, veya 1,2,3 veya 1,2,3,4 işaretlenmelidir. Haricinde hata mesajı verdirilebilir. Eğer sizi sıkmayacak isem biraz detaya gireyim;
Gayem üretim için veri kayıtları yapmak istiyorum bunun içinde önce 2 ayrı kayıt no.larını oluşturmak istiyorum. sorum bu kayıt no.ları ile ilgili.
Bir üretimde sadece 1 adet Ana ürün oluyor. en az 1 tane insört oluyor. Yani bir üretimde 1 ana ürün 1 adet insört olmak zorunda.
Ancak insört adetleri bazen 2,3,4,5 adet olabiliyor. Forumlarda araştırdığım tüm veri kayıtlarını inceledim, benim isteğime benzerini göremedim. klasik veri kayıdında şu var; bir Userform'dan textbox'lara girilen değerler commandbutton'a tıklayınca sadece 1 satıra işliyor ve son dolu satırdan itibaren 1'er 1'er artarak devam ediyor.
Benimki biraz farklı şöyleki,
örnek dosyamda 1 tane üretim textbox'u var. 5 tane insört textbox'u var. Dikkat edilirse 1.sinde checkbox yok çünkü 1 üretimde 1 insört olmak zorunda. Sırayla detaylı örnekler vereyim;
ilk defa kayıt yaptığımızı düşünelim ve kayıtların A2 ve B2'den başladığını düşünelim. (A sütunu Üretim no. B sütunu İnsört no.dur);
1.üretimde 1 tane insört var ise(yani checkbox'ların hiçbiri şeçili değil ise)
Butona 1 kere tıkladığımda
A...B
1...1

2. üretimde üretimde 3 tane üretim var ise (yani checkbox'lardan 1.si ve 2.si şeçili ise) butona 1 kere tıkladığımda 3 satır kayıt yapılmalı ve Aşağıdaki kırmızı renkli olanlar gibi olmalıdır.
Kayıtlı son üretim no.=1'dir. Son insört no.1'dir. Dolayısı ile son kaydedilen üretim no=2 olmalıdır. aynı üretim no.2'ye ait 3 tane insört olduğundan insört no.ları da 2.no, 3.no, 4.no olmalıdır.

A...B
1...1
2...2
2...3
2...4


Bundan sonra 3.bir üretim kaydı yapalım. Bu üretimde de 2 tane insört olsun(yani checkbox'larından sadece 1.si şeçili olsun)
butona 1 kere tıkladığımda 2 satır kayıt yapılmalı ve Aşağıdaki kırmızı renkli olanlar gibi olmalıdır.
A...B
1...1
2...2
2...3
2...4
3...5
3...6
İlla da checkbox'lar ile çözüm olmayabilir. Benim kafama ancak bu kadarı yattı. Böyle olması kolay olur diye düşündüm.
Sizce alternatif fikirler olursa da düşünebiliriz.

İnşallah anlatabilmiştirim.
Ayrıca daha önceden bu konu ile ilgili daha detaylı konu açtım. bir tane dahi cevap alamadım.
link buradadır:
http://www.excel.web.tr/showthread.php?t=86163

Ben de sitedeki örnek dosyaları inceleyerek kendim çözmeye çalıştım. Ancak, konunun başlangıcı olan koşullu, sıralı kayıt no. ları vermeyi beceremedim ancak hala çalışıyorum. şu anki konudaki sorum net anlatamadı isem. yukarıdaki linkteki dosyada daha detaylı anlattım.
Şimdiden çok teşekürler.
İyi çalışmalar.
 
Son düzenleme:
Selamlar,

Eğer doğru anladıysam aşağıdaki kodlar işinize yarayacaktır. Denermisiniz.

Kod: 
Option Explicit
 
Private Sub CheckBox2_Click()
    If CheckBox2 = True And CheckBox1 = False Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox2 = False
        Exit Sub
    End If
End Sub
 
Private Sub CheckBox3_Click()
    If CheckBox3 = True And (CheckBox1 = False Or CheckBox2 = False) Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox3 = False
        Exit Sub
    End If
End Sub
 
Private Sub CheckBox4_Click()
    If CheckBox4 = True And (CheckBox1 = False Or CheckBox2 = False Or CheckBox3 = False) Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox4 = False
        Exit Sub
    End If
End Sub
 
Private Sub CommandButton1_Click()
    Dim X As Byte, Say As Byte, Satır As Long
 
    For X = 1 To 4
        If Controls("CheckBox" & X) = True Then Say = Say + 1
    Next
 
    With Sheets("Sayfa1")
 
    Satır = .Cells(65536, 1).End(3).Row
 
    Select Case Say
 
        Case Is = 0
        If Satır = 1 Then
            .Cells(Satır + 1, 1) = 1
            .Cells(Satır + 1, 2) = 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
        Else
            .Cells(Satır + 1, 1) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
        End If
 
        Case Is = 1
        If Satır = 1 Then
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 2, 1)) = 1
            .Cells(Satır + 1, 2) = 1
            .Cells(Satır + 2, 2) = 2
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 2, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
        End If
 
        Case Is = 2
        If Satır = 1 Then
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 3, 1)) = 1
            .Cells(Satır + 1, 2) = 1
            .Cells(Satır + 2, 2) = 2
            .Cells(Satır + 3, 2) = 3
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 3, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
        End If
 
        Case Is = 3
        If Satır = 1 Then
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 4, 1)) = 1
            .Cells(Satır + 1, 2) = 1
            .Cells(Satır + 2, 2) = 2
            .Cells(Satır + 3, 2) = 3
            .Cells(Satır + 4, 2) = 4
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
            .Cells(Satır + 4, 4) = CDbl(IIf(i4 = "", 0, i4))
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 4, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 4, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
            .Cells(Satır + 4, 4) = CDbl(IIf(i4 = "", 0, i4))
        End If
 
        Case Is = 4
        If Satır = 1 Then
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 5, 1)) = 1
            .Cells(Satır + 1, 2) = 1
            .Cells(Satır + 2, 2) = 2
            .Cells(Satır + 3, 2) = 3
            .Cells(Satır + 4, 2) = 4
            .Cells(Satır + 5, 2) = 5
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
            .Cells(Satır + 4, 4) = CDbl(IIf(i4 = "", 0, i4))
            .Cells(Satır + 5, 4) = CDbl(IIf(i5 = "", 0, i5))
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 5, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 4, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 5, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
            .Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
            .Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
            .Cells(Satır + 4, 4) = CDbl(IIf(i4 = "", 0, i4))
            .Cells(Satır + 5, 4) = CDbl(IIf(i5 = "", 0, i5))
        End If
    End Select
 
    End With
End Sub
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
Selamlar,

Eğer doğru anladıysam aşağıdaki kodlar işinize yarayacaktır. Denermisiniz.

Kod: 
Option Explicit
 
Private Sub CheckBox2_Click()
    If CheckBox2 = True And CheckBox1 = False Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox2 = False
        Exit Sub
    End If
End Sub
 
Private Sub CheckBox3_Click()
    If CheckBox3 = True And (CheckBox1 = False Or CheckBox2 = False) Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox3 = False
        Exit Sub
    End If
End Sub
 
Private Sub CheckBox4_Click()
    If CheckBox4 = True And (CheckBox1 = False Or CheckBox2 = False Or CheckBox3 = False) Then
        MsgBox "Lütfen bir önceki onay kutusunu işaretleyin !", vbCritical
        CheckBox4 = False
        Exit Sub
    End If
End Sub
 
Private Sub CommandButton1_Click()
    Dim X As Byte, Say As Byte, Satır As Long
 
    For X = 1 To 4
        If Controls("CheckBox" & X) = True Then Say = Say + 1
    Next
 
    Satır = Cells(65536, 1).End(3).Row
 
    Select Case Say
 
        Case Is = 0
        If Satır = 1 Then
            Cells(Satır + 1, 1) = 1
            Cells(Satır + 1, 2) = 1
        Else
            Cells(Satır + 1, 1) = Cells(65536, 1).End(3).Value + 1
            Cells(Satır + 1, 2) = Cells(65536, 2).End(3).Value + 1
        End If
 
        Case Is = 1
        If Satır = 1 Then
            Range(Cells(Satır + 1, 1), Cells(Satır + 2, 1)) = 1
            Cells(Satır + 1, 2) = 1
            Cells(Satır + 2, 2) = 2
        Else
            Range(Cells(Satır + 1, 1), Cells(Satır + 2, 1)) = Cells(65536, 1).End(3).Value + 1
            Cells(Satır + 1, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 2, 2) = Cells(65536, 2).End(3).Value + 1
        End If
 
        Case Is = 2
        If Satır = 1 Then
            Range(Cells(Satır + 1, 1), Cells(Satır + 3, 1)) = 1
            Cells(Satır + 1, 2) = 1
            Cells(Satır + 2, 2) = 2
            Cells(Satır + 3, 2) = 3
        Else
            Range(Cells(Satır + 1, 1), Cells(Satır + 3, 1)) = Cells(65536, 1).End(3).Value + 1
            Cells(Satır + 1, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 2, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 3, 2) = Cells(65536, 2).End(3).Value + 1
        End If
 
        Case Is = 3
        If Satır = 1 Then
            Range(Cells(Satır + 1, 1), Cells(Satır + 4, 1)) = 1
            Cells(Satır + 1, 2) = 1
            Cells(Satır + 2, 2) = 2
            Cells(Satır + 3, 2) = 3
            Cells(Satır + 4, 2) = 4
        Else
            Range(Cells(Satır + 1, 1), Cells(Satır + 4, 1)) = Cells(65536, 1).End(3).Value + 1
            Cells(Satır + 1, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 2, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 3, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 4, 2) = Cells(65536, 2).End(3).Value + 1
        End If
 
        Case Is = 4
        If Satır = 1 Then
            Range(Cells(Satır + 1, 1), Cells(Satır + 5, 1)) = 1
            Cells(Satır + 1, 2) = 1
            Cells(Satır + 2, 2) = 2
            Cells(Satır + 3, 2) = 3
            Cells(Satır + 4, 2) = 4
            Cells(Satır + 5, 2) = 5
        Else
            Range(Cells(Satır + 1, 1), Cells(Satır + 5, 1)) = Cells(65536, 1).End(3).Value + 1
            Cells(Satır + 1, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 2, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 3, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 4, 2) = Cells(65536, 2).End(3).Value + 1
            Cells(Satır + 5, 2) = Cells(65536, 2).End(3).Value + 1
        End If
    End Select
End Sub
Genişletmek için tıkla ...

Selam, Sayın Korhan Ayhan tam istediğim gibi olmuş. Süper ellerinize sağlık. Çok teşekkür ederim. Harikasınız.

1.mesajımdaki sorum örnek dosyamdır. (Asıl dosyam http://www.excel.web.tr/showthread.php?t=86163 buradadır. Ancak hiç cevap alamadığımdan küçük örnekler ile sorumu soruyorum.) veri giriş formunu birkaç farklı sayfalardan yapacağımdan birkaç deneme yaptım, açık olan sayfa hangisi ise ona kayıt yapıyor. Ben sadece örnek dosyadaki "Sayfa1"e kayıt yapmak istiyorum. Yani veri giriş formunu nereden çağırırısam çağırayım, kayıtları "sayfa1" yapsın istiyorum. Ne gibi ekleme veya değişiklik yapmam gerekiyor?

2.si kayıt no.ları yanı sıra C ve D sütunlarına da bilgi kaydetmek istiyorum şöyleki;
urt1 yani textbox1 (ana ürün adı olsun)
i1 yani textbox2 (1. insört adı olsun)
i2 yani textbox3 (2. insört adı olsun)
i3 yani textbox4 (3. insört adı olsun)
i4 yani textbox5 (4. insört adı olsun)
i5 yani textbox6 (5. insört adı olsun)
Kayıt şu şekilde olsun
1 insört var ise (yani hiçbir checkbox seçili değil ise)
A...B.........C.............D
1...1.....Ana ürün......İnsört1.....

2 insört var ise (yani sadece checkbox1 seçili ise)
A...B.........C.............D
1...1.....Ana ürün......İnsört1.....
1...2.......................İnsört2.....

3 insört var ise (yani checkbox1 ve checkbox2 seçili ise)
A...B.........C.............D
1...1.....Ana ürün......İnsört1.....
1...2.......................İnsört2.....
1...3.......................İnsört3.....

Yani Ana ürün 1 tane olduğundan sadece ait olduğu üretim no.nun ilk satırında bilgisi olsun.

Şimdiden çok teşekkürler.
 
Son düzenleme:
Selam Sayın Korhan Ayhan,
5.sıradaki mesajıma bakabilirseniz çok sevinirim.
Saygılar.
 
Selam Sayın Korhan Ayhan,
5.mesajımdaki soruma bir bakabilirseniz çok sevinirim. Ancak, çok şey istedi isem hakkınızı helal ediniz. Bu zamana kadar ki yaptığınız yardımlarınız için çok teşekkürler.
 
Selamlar,

#4 nolu mesajımdaki dosyayı ve kodu güncelledim. Denermisiniz.
 
Selam Sayın Korhan Ayhan,
İstediğim gibi olmuş çok teşekkür ederim.
Sadece, insört isimleri girdiğim i1, i2, i3, i4, i5 adlı textboxlara metin girince hata veriyordu. Sadece sayı girince hata vermiyordu.

Ben de haddim olmayarak sizin kodlarınızdaki
Kod: 
.Cells(Satır + 1, 4) = CDbl(IIf(i1 = "", 0, i1))
.Cells(Satır + 2, 4) = CDbl(IIf(i2 = "", 0, i2))
.Cells(Satır + 3, 4) = CDbl(IIf(i3 = "", 0, i3))
.Cells(Satır + 4, 4) = CDbl(IIf(i4 = "", 0, i4))
.Cells(Satır + 5, 4) = CDbl(IIf(i5 = "", 0, i5))
kısımları

Kod: 
.Cells(Satır + 1, 4) = i1
.Cells(Satır + 2, 4) = i2
.Cells(Satır + 3, 4) = i3
.Cells(Satır + 4, 4) = i4
.Cells(Satır + 5, 4) = i5
gibi değiştirdim. Sorun düzeldi. Bir ded kayıt yaptıktan sınra yeni kayıt için textbox ve checkboxları temizlemek için kodların en sonuna

Kod: 
urt1 = ""
i1 = ""
i2 = ""
i3 = ""
i4 = ""
i5 = ""
CheckBox1 = False
CheckBox2 = False
CheckBox3 = False
CheckBox4 = False
ekledim ve bir sorun göremedim. sizce uygun mudur? hesaba katmadığımız bir problem olmaz değilmi?

bir sorum daha olacak;

1.Satırda başlıklar var. verdiğiniz kodlar ile kayıtları 2.satırdan başlatıyoruz. Kayıtları 3.satırdan başlatmayı deneyeyim dedim, birkaç kodu değiştirdim, yapamadım. Nasıl yapabilirim?

İyi çalışmalar.
 
Selamlar,

Yaptığınız düzenlemelerin bir problem yaratacağını düşünmüyorum.

Kayıtları 3. satırdan başlatmak için kodun içindeki aşağıdaki bloğu bulun;

Kod: 
    Select Case Say
 
        Case Is = 0
        If Satır = 1 Then
            .Cells(Satır + [COLOR=red]1[/COLOR], 1) = 1
            .Cells(Satır + [COLOR=red]1[/COLOR], 2) = 1
            .Cells(Satır + [COLOR=red]1[/COLOR], 3) = urt1
            .Cells(Satır + [COLOR=red]1[/COLOR], 4) = CDbl(IIf(i1 = "", 0, i1))

Buradaki kırmızı değerleri 2 olarak değiştirip deneyin.
 
Selam,
Çok teşekkür ederim.
Sadece verdiğiniz kısmı düzelttim. checkbox'lar şeçili değilken 3.satırdan başlıyor. Ancak, checkbox'ların herhangi biri şeçili ise yine 2.satırdan başlıyor. Acaba tüm satır+1 yazanları mı satır+2 yapacağım?
 
Selamlar,

CommandButton1 nesnesine ait kodu aşağıdaki şekilde değiştirip kullanabilirsiniz.

Kod: 
Private Sub CommandButton1_Click()
    Dim X As Byte, Say As Byte, Satır As Long
        
    For X = 1 To 4
        If Controls("CheckBox" & X) = True Then Say = Say + 1
    Next
    
    With Sheets("Sayfa1")
    
    Satır = .Cells(65536, 1).End(3).Row
        
    Select Case Say
        
        Case Is = 0
        If Satır = 1 Then
            .Cells(Satır + 2, 1) = 1
            .Cells(Satır + 2, 2) = 1
            .Cells(Satır + 2, 3) = urt1
            .Cells(Satır + 2, 4) = i1
        Else
            .Cells(Satır + 1, 1) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = i1
        End If
        
        Case Is = 1
        If Satır = 1 Then
            .Range(.Cells(Satır + 2, 1), .Cells(Satır + 3, 1)) = 1
            .Cells(Satır + 2, 2) = 1
            .Cells(Satır + 3, 2) = 2
            .Cells(Satır + 2, 3) = urt1
            .Cells(Satır + 2, 4) = i1
            .Cells(Satır + 3, 4) = i2
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 2, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = i1
            .Cells(Satır + 2, 4) = i2
        End If
        
        Case Is = 2
        If Satır = 1 Then
            .Range(.Cells(Satır + 2, 1), .Cells(Satır + 4, 1)) = 1
            .Cells(Satır + 2, 2) = 1
            .Cells(Satır + 3, 2) = 2
            .Cells(Satır + 4, 2) = 3
            .Cells(Satır + 2, 3) = urt1
            .Cells(Satır + 2, 4) = i1
            .Cells(Satır + 3, 4) = i2
            .Cells(Satır + 4, 4) = i3
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 3, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = i1
            .Cells(Satır + 2, 4) = i2
            .Cells(Satır + 3, 4) = i3
        End If
        
        Case Is = 3
        If Satır = 1 Then
            .Range(.Cells(Satır + 2, 1), .Cells(Satır + 5, 1)) = 1
            .Cells(Satır + 2, 2) = 1
            .Cells(Satır + 3, 2) = 2
            .Cells(Satır + 4, 2) = 3
            .Cells(Satır + 5, 2) = 4
            .Cells(Satır + 2, 3) = urt1
            .Cells(Satır + 2, 4) = i1
            .Cells(Satır + 3, 4) = i2
            .Cells(Satır + 4, 4) = i3
            .Cells(Satır + 5, 4) = i4
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 4, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 4, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = i1
            .Cells(Satır + 2, 4) = i2
            .Cells(Satır + 3, 4) = i3
            .Cells(Satır + 4, 4) = i4
        End If
        
        Case Is = 4
        If Satır = 1 Then
            .Range(.Cells(Satır + 2, 1), .Cells(Satır + 6, 1)) = 1
            .Cells(Satır + 2, 2) = 1
            .Cells(Satır + 3, 2) = 2
            .Cells(Satır + 4, 2) = 3
            .Cells(Satır + 5, 2) = 4
            .Cells(Satır + 6, 2) = 5
            .Cells(Satır + 2, 3) = urt1
            .Cells(Satır + 2, 4) = i1
            .Cells(Satır + 3, 4) = i2
            .Cells(Satır + 4, 4) = i3
            .Cells(Satır + 5, 4) = i4
            .Cells(Satır + 6, 4) = i5
        Else
            .Range(.Cells(Satır + 1, 1), .Cells(Satır + 5, 1)) = .Cells(65536, 1).End(3).Value + 1
            .Cells(Satır + 1, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 2, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 3, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 4, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 5, 2) = .Cells(65536, 2).End(3).Value + 1
            .Cells(Satır + 1, 3) = urt1
            .Cells(Satır + 1, 4) = i1
            .Cells(Satır + 2, 4) = i2
            .Cells(Satır + 3, 4) = i3
            .Cells(Satır + 4, 4) = i4
            .Cells(Satır + 5, 4) = i5
        End If
    End Select
    
    End With
End Sub
 
Sayın Korhan Ayhan,
Verdiğiniz kodları denedim. Tam istediğim gibi olmuş. Ellerinize sağlık. Çok teşekkür ederim.
Sizlerin sayesinde kodları asıl dosyama uyguluyorum. Ancak, bir yandan başka ihtiyaçlar da oluyor. mesela örnek dosyamdaki birer kutu olarak sunduğum dosyalar 5-10 kutu ve ben bunlara seri numara veriyorum. Urt101,urt102.... i101,i102,.... i201,i202... gibi kod bayağı uzuyor. bunları kısaltmak için kendi kendime denemeler yapıyorum. anlamıyorum ancak "for next" gib şeyleri deniyorum. yapmadığımız zaman yardım anlak istiyorum. Acaba farklı konu mu açmam gerekiyor? eğer başka bir konuda bunları sorar isem baba yardımcı olabilir misiniz?
İyi çalışmalar.
 
Selamlar,

Bu başlık altında sorularınıza devam edebilirsiniz.
 
Selam,

utx_002, utx_003, utx_004, utx_005, utx_006
adlı textbox kutuları var.
bunları 3,4,5,6,7 kolonlara For-Next döngüsü ile yazmak istedim beceremedim.
aşağıdaki kod ile yazılan verileri değil kutuların adlarını yazıyor.
utx_00 & Y
(utx_00 & Y)
(utx_00 & Y).Value
(utx_00 & Y).Text
v.s. denedim. yapamadım.
Kod: 
For Y = 2 To 6
.Cells(Satır + 1, Y + 1) = "utx_00" & Y
Next
Yardımcı olabilirseniz çok sevinirm
 
Selamlar,

Aşağıdaki şekilde deneyin.

Kod: 
.Cells(Satır + 1, Y + 1) = Me.Controls("utx_00" & Y)
 
Selam,
Çok özür dilerim. Sorun benden kaynaklanıyormuş.
5'e kadar kutu varmış.
aşağıdaki gibi yaptım düzeldi
Kod: 
For Y = 2 To 5
            .Cells(Satır + 2, Y + 1) = Controls("utx_00" & Y)
            Next
Çok teşekkürler.
iyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst