• DİKKAT

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

Tabloya yerleştir

Mdemir63

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,989
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Selamlar,

Arkadaşlar ekteki dosyada VERİ SAYFASINDA ki isimleri K sütunundaki A,B,C kriterlerine göre ilgili sayfalara yerleştirmek istiyorum. Belli bir aşamasını da yapıyorum ancak taplodan taşan kısımları tablonun yanındaki kısımdan itibaren yerleştiremiyorum. Çözümü için yardımlarınızı bekliyor ve saygılar sunuyorum.
 
Kodlarınızı aşağıdaki gibi değiştirin

Kod: 
Sub A()
Dim B
Sheets("A SINIFI").Select
B = 2
C = 4
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
  If secim = "A" Then
      B = B + 1
      If B = 37 Then: C = 9: B = 3
      Worksheets("A SINIFI").Cells(B, C) = secim.Offset(0, -9)
      Worksheets("A SINIFI").Cells(B, C - 2) = secim.Offset(0, -8)
      Worksheets("A SINIFI").Cells(B, C - 1) = secim.Offset(0, -1)
  End If
Next
MsgBox "A sınıfı oluşturuldu"
End Sub

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

Kod: 
Sub D()
Dim B
Sheets("C SINIFI").Select
B = 2
C = 4
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
    If secim = "C" Then
    B = B + 1
    If B = 37 Then: C = 9: B = 3
    Worksheets("C SINIFI").Cells(B, C) = secim.Offset(0, -9)
    Worksheets("C SINIFI").Cells(B, C-2) = secim.Offset(0, -8)
    Worksheets("C SINIFI").Cells(B, C-1) = secim.Offset(0, -1)
End If
Next
End Sub
 
Sayın: fpc

Ellerinize sağlık çok teşekkür ederim.

Saygılar
 
Hocam 35. sıraya yazmadan geçiyor bakabilirmisiniz.
 
Hocam özür

If B = 37 Then: C = 9: B = 3
If B = 38 Then: C = 9: B = 3
38 yaptım düzeldi sağolun
 
Hocam ne demek kusur. Rica ederim.
Yalnız sizden aşağıdaki kodlardan satırların ne anlama geldiğini açıklayabilirmisiniz. Ben anlayabildiklerimi yazdım belki onlar içinde de yanlış anladığım olabilir.

Saygılar


Sub A()
Dim B '?
Sheets("A SINIFI").Select ' A sınıfı sayfasını seç
B = 2 '?
C = 4 '?
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K") ' Veri sayfasındaki K sütununa göre seç
If secim = "A" Then ' A olanları seç
B = B + 1 '?
If B = 37 Then: C = 9: B = 3 '?
Worksheets("A SINIFI").Cells(B, C) = secim.Offset(0, -9)' ?
Worksheets("A SINIFI").Cells(B, C - 2) = secim.Offset(0, -8)' ?
Worksheets("A SINIFI").Cells(B, C - 1) = secim.Offset(0, -1)'?
End If
Next
MsgBox "A sınıfı oluşturuldu"
End Sub​
 
Elbette açıklarım. Şöyle:

Kod: 
Dim B '?
Bu bir değişken tanımlama için kullanılmış komuttur. Esasen şu şekilde yazılması gerekirdi : "Dim B as Integer". Ama işin biraz kolayına kaçılmış. Bizim projemiz küçük bir kod bloğu olduğu için, kodumuzda değişken tanımlamalarını yapmasak da olurdu.

Kod: 
B = 2 '?
Satır numaralandırma veya yazdırılacak hücrenin satırını belirleyen değişken diyebiliriz. (For next döngüsünde kullanım için)

Kod: 
C = 4 '?
Sütun numaralandırma veya yazdırılacak hücrenin sütununu belirleyen değişken diyebiliriz.(For next döngüsünde kullanım için)

Kod: 
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
Anlamı : "K sütundan her bir hücre için döngüye başla ve her seçtiğin hücreye secim ismini ver" demek. Normalde K1'den başlayıp, K65536 ya kadar herbir hücreye bakar.

Kod: 
If secim = "A" Then
Anlamı : Eğer secim adlı hücrenin değeri "A" ise aşağıdakileri yap. Değilse End If'e git. Bu Excel'deki Eğer fonksiyonuna benzer.

Kod: 
B = B + 1
Döngüye her girildiğinde B değeri 1 artır. Bunun anlamı şudur : Yukarıda belirtiğimiz gibi döngü K1, K2, K3 .... K65536 şeklinde sırasıyla hücreleri kontrol ediyor. Herbir hücreye gelindiğinde, yukarıda koşul sağlanırsa, "A Sınıfı" sheetindeki en son boş hücreye bu değeri yazıyor. Buradaki "B" de en son yazılacak satır numarasını belirliyor. Önce 1.satıra sonra, 2.satıra, sonra 3. satıra ... gibi..

Kod: 
If B = 38 Then: C = 9: B = 3
Bu satırı -biliyorsunuz- sonradan ilave ettik. Burada şunu kontrol ediyoruz. Eğer 1.satır, 2.satır... 37.satır bunlar sırasıyla yazıldı. Döngüde 38.satıra gelindiğinde; yan tarafa geçmemiz gerekiyordu.

Böylelikle 38.satır gelindiğinde; yan tarafa yazdırmak için satır değerini 3'e indirmemiz, sütun değerini de 9'a çıkarmamız gerekiyordu. Yani I3'ten başlayarak yeniden yazdırmaya başlamayı ayarlıyoruz.

Kod: 
Worksheets("A SINIFI").Cells(B, C) = secim.Offset(0, -9)
Döngünün ilk adımında B=3 (:Satır) ve C=4 (:Sütun) ... Yani "A Sınıfı" sayfasındaki D3 hücresine değer ataması yapıyor. Bu değer; döngüde denk gelen "secim" adlı hücrenin 9 hücre solundaki değer... Bu da muhtemelen öğrenci İsmine denk geliyor. İlk veriyi "A Sınıfı" sayfasına böyle yazdırıyoruz ve daha sonra; "secim" bir sonraki hücreye kayıyor ve B'nin değeri artıyor.

Kod: 
Worksheets("A SINIFI").Cells(B, C - 2) = secim.Offset(0, -8)
Worksheets("A SINIFI").Cells(B, C - 1) = secim.Offset(0, -1)
Bunlarda da yukarıdakine benzer bir mantık var. İlk satırda; secilen hücrenin, 8 hücre solundaki değeri, ikinci satırda 1 hücre solundaki değeri alıyoruz ve "A Sınıfında" ki ilgili hücreye yazdırıyoruz.

Koşulun sonu ...
Döngünün sonu ...
Mesaj gösterimi ...
Makronun sonu ...

Umarım açıklayıcı olmuştur.
 
Hocam çok teşekkür ediyorum. Ancak bu kadar açıklayıcı olabilirdi

Saygılar sunuyorum
 
Selamlar,
Hocam aşağıdaki Bu aralığı (Range("B3:37,G3:I37").ClearContents) aktarırken öncekini sildikten sonra aktarmasını istiyorum ama hata veriyor.
Nedenini bulamadım . Bakabilirmisiniz.

Saygılar

Sub A()
Dim B
Sheets("A SINIFI").Select
Range("B3:37,G3:I37").ClearContents
B = 2
C = 4
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
If secim = "A" Then
B = B + 1
If B = 37 Then: C = 9: B = 3
Worksheets("A SINIFI").Cells(B, C) = secim.Offset(0, -9)
Worksheets("A SINIFI").Cells(B, C - 2) = secim.Offset(0, -8)
Worksheets("A SINIFI").Cells(B, C - 1) = secim.Offset(0, -1)
End If
Next
MsgBox "A sınıfı oluşturuldu"
End Sub​
 
Bahsettiğiniz aralık tanımlamasında hata var. Şu şekilde olabilir. Kırmızı sütun başlığını siz isteğinize göre değiştirin

Range("B3:B37", "G3:I37").ClearContents
 
fpc' Alıntı:
Bahsettiğiniz aralık tanımlamasında hata var. Şu şekilde olabilir. Kırmızı sütun başlığını siz isteğinize göre değiştirin

Range("B3:B37", "G3:I37").ClearContents
Genişletmek için tıkla ...

Teşekkür ederim. yalnız bu aralıkların dışında F sütununu da siliyor F sütununda otomatik numara veren formülüm var onu silmesini istemiyorum. Onun için ne yapabilirim?

Saygılar
 
fpc' Alıntı:
Ekteki dosyayı inceleyiniz.
Genişletmek için tıkla ...

Hocam elinize sağlık ama sıra numarasını nasıl verdiriyorsunuz. Aşağıdaki kodlardaki satırları size zahmet açıklayabilirmisiniz?

Saygılar sunarım.



Sub A()
Dim B
Sheets("A SINIFI").Select 'A SINIFI SAYFASINI SEÇ
Range("A3:J37").ClearContents ' A3, J37 aralığını sil
B = 2
C = 4
For Each secim In Worksheets("VERİ SAYFASI").Range("K:K")
If secim = "A" Then
B = B + 1
x = x + 1 '?
If B = 38 Then: C = 9: B = 3
Worksheets("A SINIFI").Cells(B, C) = secim.Offset(0, -9)
Worksheets("A SINIFI").Cells(B, C - 2) = secim.Offset(0, -8)
Worksheets("A SINIFI").Cells(B, C - 1) = secim.Offset(0, -1)
Worksheets("A SINIFI").Cells(B, C - 3) = x ' ?

End If
Next
MsgBox "A sınıfı oluşturuldu"
End Sub
 
x=x+1 satırında; koşul sağlandıkça değeri +1 artan bir "x" değişkeni tanımladık. Koşulun sağlanması demek K sütununda "A" değerinin olup olmamasıydı. Eğer "A" görürse; "x"in değerinin +1 artırıyor

Sonrada; Worksheets("A SINIFI").Cells(B, C - 3) = x satırı ile; tıpkı ismi ve numarayı nasıl yazdırıyorsak, belirlenen bu "x" değişkenini de istediğimiz hücreye yazdırıyoruz.
 
Hocam çok teşekkürler
çok emeğiniz geçti helal edin lütfen

Saygılar sunarım.
 
Helallikse; helal olsun. Ama çok birşey yapmadık açıkçası...

Kolay gelsin. Çalışmalarınızda başarılar
 
Selamlar,

Hocam çok rahatsız ettim ama, bu 3 sınıf makrosunu birtek butona nasıl bağlayabilirim. Yani Sınıfları oluştur diye bir buton yapıp, o butona tıkladığımızda üç sınıfı birden oluştursun. Ben uğraştım üç ayrı makroyu birleştirmeye çalıştım fakat elime yüzüme bulaştırdım. Olabilirse çok sevinirim.

Saygılar sunarım.
 
Yeni bir modül sayfası oluşturun.

Aşağıdaki kodu yazın.

Kod: 
Sub HepsiniDagit()
Call A
Call B
Call D
End Sub

Sayfadaki bütün butonları silin ve yeni bir buton yapın. Yeni butona da, bu makroyu atayın. Ardı ardına makrolar çalışıp, sınıfların hepsine dapıtım yapacaktır. Ama sakın mevcut kodları işleri bitti diye silmeyin :)
 
Selamlar,
Hocam yaptım oldu . tekrar teşekkürler. Hocam bunlar neyi ifade ediyor acaba?
Call A '?
Call B '?
Call D '?

Saygılar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst