Listeyi Sınıflara Paylaştırma

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Selamlar,

Arkadaşlar elimde bir isim listem var ve ben bunu 70 - 40 - 40 olarak 3 adet sınıf yapmak istiyorum. Nasıl yapabilirim?

Dosyada açıklamaya çalıştım.

Şimdiden çok teşekkürler

Saygılar
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Aşağıdaki şekilde dener misiniz?
Kod:
Sub yerlestir()
Set s1 = Sheets("VERİ SAYFASI")
With Sheets("A SINIFI")
    .[b3:b37] = s1.[c2:c36].Value 'kurs no
    .[c3:c37] = s1.[j2:j36].Value 'sicil no
    .[d3:d37] = s1.[b2:b36].Value 'ad soyad
    
    .[g3:g37] = s1.[c36:c71].Value
    .[h3:h37] = s1.[j36:j71].Value
    .[i3:i37] = s1.[b36:b71].Value
End With
With Sheets("B SINIFI")
    .[b3:b37] = s1.[c72:c107].Value
    .[c3:c37] = s1.[j72:j107].Value
    .[d3:d37] = s1.[b72:b107].Value
    
    .[g3:g37] = s1.[c108:c142].Value
    .[h3:h37] = s1.[j108:j142].Value
    .[i3:i37] = s1.[b108:b142].Value
End With
With Sheets("C SINIFI")
    .[b3:b37] = s1.[c143:c177].Value
    .[c3:c37] = s1.[j143:j177].Value
    .[d3:d37] = s1.[b143:b177].Value
    
    .[g3:g37] = s1.[c178:c212].Value
    .[h3:h37] = s1.[j178:j212].Value
    .[i3:i37] = s1.[b178:b212].Value
End With
End Sub
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Hamitcan hocam merhabalar

Elinize sağlık istediğim buydu A sınıfı tamam 70 olacaktı ancak B ve C sınıfları 40 ar kişi olacaktı bunun için ne yapabilirim?

Saygılar
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Hocam tekrar merhaba

en son bahsettiklerim ben hallettim çok teşekkür ederim.

Saygılar
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Ayrı ayrı düğmelere bağlamak istemişsiniz, yeni fark ettim. Aşağıdaki kodu "VERİ SAYFASI" kod kısmına ekleyin.
Kod:
Dim s1 As Object
Private Sub CommandButton1_Click()
With Sheets("A SINIFI")
    .[b3:d37,g3:i37] = ""
    .[b3:b37] = s1.[c2:c36].Value 'kurs no
    .[c3:c37] = s1.[j2:j36].Value 'sicil no
    .[d3:d37] = s1.[b2:b36].Value 'ad soyad
    
    .[g3:g37] = s1.[c36:c71].Value
    .[h3:h37] = s1.[j36:j71].Value
    .[i3:i37] = s1.[b36:b71].Value
End With
End Sub
Private Sub CommandButton2_Click()
With Sheets("B SINIFI")
    .[b3:d37,g3:i37] = ""
    .[b3:b37] = s1.[c72:c107].Value
    .[c3:c37] = s1.[j72:j107].Value
    .[d3:d37] = s1.[b72:b107].Value
    
    .[g3:g37] = s1.[c108:c142].Value
    .[h3:h37] = s1.[j108:j142].Value
    .[i3:i37] = s1.[b108:b142].Value
End With
End Sub

Private Sub CommandButton3_Click()
With Sheets("C SINIFI")
    .[b3:d37,g3:i37] = ""
    .[b3:b37] = s1.[c143:c177].Value
    .[c3:c37] = s1.[j143:j177].Value
    .[d3:d37] = s1.[b143:b177].Value
    
    .[g3:g37] = s1.[c178:c212].Value
    .[h3:h37] = s1.[j178:j212].Value
    .[i3:i37] = s1.[b178:b212].Value
End With
End Sub

Private Sub Worksheet_Activate()
Set s1 = Sheets("VERİ SAYFASI")
End Sub
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Hocam teşekkürler elinize sağlık
Saygılar


Hocam bir şey sormak istiyorum.

Dim s1 As Object
yukarıdaki kod olduğu içinmi sayfanın kod penceresin yazmamız gerekli yoksa ayrı butonlara bağlamak istediğimizden mi sayfanın kod penceresine yazmamız gerekli?
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
"s1" burada sayfa ismi olarak tanımlanmıştır. Amacım sayfa ismini uzun uzun yazmak yerine daha kısa oalarak yazmaktı.Sayfa aktif edildiğinde VERİ SAYFASI isimli sayfayı "s1" değişkenine atamaktadır.
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Teşekkürler hocam

Saygılar
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Selamlar,

Arkadaşlar sorunu dosyada açıkladığım gibi çözebilirmiyiz?


Saygılar sunuyorum



Dosya ekte
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Arkadaşlar hiçbir fikri olan yok mu?
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Arkadaşlar merhabalar,

Kendim uğraştım birşeyler yaptım. Sadece aktardığım sayfalardaki tablomun dışında kalan kırmızı kısımlar, tablodaki yan taraftaki kırmızı yerlere gelecek şekle getiremedim. Bakabilirseniz çok sevinirim.Kırmızı kısımları anlaşılması için ben o renk yaptım. Yani tablomdaki yan taraftan devam etmesi gerekiyor.

Dosyamı ekliyorum

Saygılar sunuyorum
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Günaydınlar,

Arkadaşlar dosyama bir göz atabilirmisiniz?


Saygılar
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Selamlar,
Arkadaşlar aşağıdaki kodlarla istediğimin bir bölümünü yapıyorum. Sadece sınıf listelerindeki 35.satırdan sonraki kısımlar tablodaki 36. satırdan itibaren yerleşsin istiyorum.Bunun için bir çözüm yolu olan var mı? Eklediğim son dosyada görmek istedikleriniz var. Lütfen Uzman ve yönetici arkadaşlarımız ilgilenirlerse çak mabule geçer.

Saygılar sunarım.

Sub A()
Dim B
Sheets("A SINIFI").Select
B = 2
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
If secim = "A" Then
B = B + 1
Worksheets("A SINIFI").Cells(B, 4) = secim.Offset(0, -9)
Worksheets("A SINIFI").Cells(B, 2) = secim.Offset(0, -8)
Worksheets("A SINIFI").Cells(B, 3) = secim.Offset(0, -1)

End If
Next

End Sub
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Selamlar

istediğimi yapabilmek için Verdiğim kodların neresini değiştirmeliyim

Saygılar
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Kodları aşağıdaki şekilde yeniden düzenledim.
Kod:
Sub AKTAR()
Dim a, aa, b, bb, c, cc As Integer
Set sh = Sheets("VERİ SAYFASI")
son = [b65536].End(3).Row
a = 2: aa = 2: b = 2: bb = 2: c = 2: cc = 2
Sheets(Array("A SINIFI", "B SINIFI", "C SINIFI")).Select
[b3:e37,g3:j37].ClearContents
sh.Select

For i = 2 To son
With Sheets(Cells(i, "K") & " SINIFI")
  'A SINIFI
        If sh.Cells(i, "K") = "A" And a > 36 Then
        aa = aa + 1
            .Cells(aa, "G") = sh.Cells(i, "C")
            .Cells(aa, "H") = sh.Cells(i, "J")
            .Cells(aa, "I") = sh.Cells(i, "B")
       ElseIf sh.Cells(i, "K") = "A" And a <= 36 Then
       a = a + 1
            .Cells(a, "B") = sh.Cells(i, "C")
            .Cells(a, "C") = sh.Cells(i, "J")
            .Cells(a, "D") = sh.Cells(i, "B")
       End If
 'B SINIFI
        If sh.Cells(i, "K") = "B" And b > 36 Then
        bb = bb + 1
            .Cells(aa, "G") = sh.Cells(i, "C")
            .Cells(aa, "H") = sh.Cells(i, "J")
            .Cells(aa, "I") = sh.Cells(i, "B")
       ElseIf sh.Cells(i, "K") = "B" And b <= 36 Then
       b = b + 1
            .Cells(b, "B") = sh.Cells(i, "C")
            .Cells(b, "C") = sh.Cells(i, "J")
            .Cells(b, "D") = sh.Cells(i, "B")
       End If
    'C SINIFI
        If sh.Cells(i, "K") = "C" And c > 36 Then
        cc = cc + 1
            .Cells(cc, "G") = sh.Cells(i, "C")
            .Cells(cc, "H") = sh.Cells(i, "J")
            .Cells(cc, "I") = sh.Cells(i, "B")
       ElseIf sh.Cells(i, "K") = "C" And c <= 36 Then
       c = c + 1
            .Cells(c, "B") = sh.Cells(i, "C")
            .Cells(c, "C") = sh.Cells(i, "J")
            .Cells(c, "D") = sh.Cells(i, "B")
       End If
    End With
Next
End Sub
 
Son düzenleme:

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
hocam merhabalar,

kodları göndermişsiniz teşekkürler ancak hata veriyor birbakabilirmisiniz?

saygılar



not : hata ekteki dosyada
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Hocam merhabalar,

Ellerinize sağlık çok teşekkürler.
fazla oluyorum ama öğrenmek için vaktiniz varsa aşağıdaki kodlarda ben anlayabildiğim kadarıyla kod satırını açıklamaya çalıştım. Diğerlerini de siz açıklayabilirmisiniz.

SAYGILAR

Sub AKTAR()
Dim a, aa, b, bb, c, cc As Integer
Set sh = Sheets("VERİ SAYFASI")
son = [b65536].End(3).Row
a = 2: aa = 2: b = 2: bb = 2: c = 2: cc = 2
Sheets(Array("A SINIFI", "B SINIFI", "C SINIFI")).Select
[b3:e37,g3:j37].ClearContents ‘ A, B, C SINIFLARINI SEÇ b3:e37,g3:j37 ARALIKLARI SİL
sh.Select

For i = 2 To son
With Sheets(Cells(i, "K") & " SINIFI")
'A SINIFI
If sh.Cells(i, "K") = "A" And a > 36 Then
aa = aa + 1
.Cells(aa, "G") = sh.Cells(i, "C")
.Cells(aa, "H") = sh.Cells(i, "J")
.Cells(aa, "I") = sh.Cells(i, "B")
ElseIf sh.Cells(i, "K") = "A" And a <= 36 Then
a = a + 1
.Cells(a, "B") = sh.Cells(i, "C")
.Cells(a, "C") = sh.Cells(i, "J")
.Cells(a, "D") = sh.Cells(i, "B")
End If
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Kod:
Sub AKTAR()
Dim a, aa, b, bb, c, cc As Integer 'Değişkenleri tanımla
Set sh = Sheets("VERİ SAYFASI") 'VERİ SAYFASINI sh olarak tanımla
son = [b65536].End(3).Row 'son hücreyi bul
a = 2: aa = 2: b = 2: bb = 2: c = 2: cc = 2 'sayaçlar 2.satırdan başlasın
Sheets(Array("A SINIFI", "B SINIFI", "C SINIFI")).Select
[b3:e37,g3:j37].ClearContents ' A, B, C SINIFLARINI SEÇ b3:e37,g3:j37 ARALIKLARI SİL
sh.Select

For i = 2 To son 'son hücre kadar dön
With Sheets(Cells(i, "K") & " SINIFI") 'K sütundaki hücre değerine SINIFI kelimesini ekle
                                        've sayfa ismi olarak tanımla.Bu sayfa ile birlikte aşağıdakileri yap.
'A SINIFI
If sh.Cells(i, "K") = "A" And a > 36 Then 'K sütunundaki ilgili hücre "A" ya eşitse ve sayaç a, 36 dan büyükse
aa = aa + 1 'aa yı bir arttır.
.Cells(aa, "G") = sh.Cells(i, "C") 'Veri sayfasındaki C sütunundaki ilgili hücreyi,
                                    'Sheets(Cells(i, "K") & " SINIFI") şeklinde tespit edilmiş sayfada
                                    'C sütunda sayaç tarafından belirlenmiş satıra eşitle
.Cells(aa, "H") = sh.Cells(i, "J") 'aynısı
.Cells(aa, "I") = sh.Cells(i, "B") 'aynısı
ElseIf sh.Cells(i, "K") = "A" And a <= 36 Then 'K sütunundaki ilgili hücre "A" ya eşitse ve sayaç a, 36 dan küçükse
a = a + 1 'a yı bir arttır.
.Cells(a, "B") = sh.Cells(i, "C") 'Veri sayfasındaki C sütunundaki ilgili hücreyi,
                                    'Sheets(Cells(i, "K") & " SINIFI") şeklinde tespit edilmiş sayfada
                                    'B sütunda sayaç tarafından belirlenmiş satıra eşitle
.Cells(a, "C") = sh.Cells(i, "J") 'aynısı
.Cells(a, "D") = sh.Cells(i, "B") 'aynısı
End If
 

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,864
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
Hocam hakk&#305;n&#305;z&#305; &#246;deyemeyiz
Sayg&#305;lar sunuyorum, iyi ki vars&#305;n&#305;z
 
Üst