Makro İle Kişi ve Değer Süzerek Sonuç İşleme

[fluess]

Makro ile Düşeyara benzeri bir uygulama yapabilme

Arkadaşlar bir excel kitapçığının bir sayfasından diğer sayfasına makro kullanarak ana listedeki kişileri tarayıp sonuçlarını işletmek istiyorum. Ben formül kullanarak bayağı bir çalıştım fakat olmadı. Dosyam ekte bakarsanız sevinirim...
Excel Sayfa 1 de gerekli açıklamalar mevcut.

 

[revelte]

Hazırladığım örneği bir inceleyin. Değiştirilmesi gereken bir şey varsa yardımcı olmaya çalışırım tekrar.

Dosya biraz büyük olduğundan bu eki kaldırıyorum, son hali son mesajımda

 

[fluess]

Öncelikle emeğiniz için teşekkür ediyorum.
Ancak bazı kişiler Ana listede (MASA1) mevcut fakat Sheet6-12-18-24 de yok. Hazırlamış olduğunuz makro o kişilere de değer atıyor.
Ben Olmayan kişileri renklendirip tekrar dosyayı ekliyorum.

 

[revelte]

Selamlar,

Öncelikle geç yanıt yazdığım için kusura bakmayın, ancak fırsat bulabiliyorum. Bahsettiğiniz soruna neyin sebep olduğunu biliyorum. Kodu bir fonksiyon şeklinde hazırladığımdan geriye değer döndürmek gerekiyordu. Boş string döndürdüğümde istediğiniz gibi oluyordu fakat sağda bulunan toplama formülleri çalışmıyordu. 0 döndürerek bu toplamları değiştirmeden işinizi göreceğini düşünmüştüm ama maalesef işinizi görmüyormuş.

Kodu değiştirdim ve bir butona tanımladım. Listeyi güncellemek istediğinizde tıklamanız gerekiyor. Ayrıca belge içerisinde belirttiğiniz listede olmayanları ekleme özelliğini de eklemeye çalıştım. Olmayan kişileri listenin altına biçimlendirme olmadan ekliyor.

Yalnız bir konuda kafam karıştı, son gönderdiğiniz belgede bazı satırları sarı olarak işaretlemişsiniz ve o hücrelere bir şey yazılmaması gerektiğini söylemişsiniz. Bu kişiler ilgili sayfalarda görünüyor. Ben mi yanlış anlıyorum acaba.

Hazırladığım belgeyi inceleyin, bir sorun olursa yardımcı olmaya çalışırım tekrar.

 

[fluess]

Teşekkür

Hocam çok teşekkür ediyorum. Sarı alanlar konusunda haklısın. Bazı kişiler var bazı kişiler yok ama ben bunu yazarken düşündüğüm şu idi. sheetlerdeki tablolarda öğrencilerin bazıları 1.sırada karşılıklı bazıları 2.sırada bazıları 3. sırada bazıları ise 4.sırada karşılıklı yer alıyor. benim size gönderdiğim örnekte ana listedeki kişilerin tamamı 1.sırada karşılıklı oturanlara ait. Ondan dolayı listede olupta 1.sırada olmayanlar sarı renkteler. Yani öğrenci mevcut ama 1.sırada değil. o yüzden liste dışı olması gerekiyor. (tabi ben bunu başta yazmalıydım. Özür diliyorum.)

Bir de şunu sorayım. Tabloda son olarak biz sheet24 teki verileri 4T'ye aktardık. Ancak diyelim ki sheet27 sheet30 sheet33 v.b yeni sayfalar ekleyince onları da 5T, 6T... gibi alanlara nasıl aktartmam gerekir. Bu olay 15T olanan kadar kullanımıma açık.
Bazı zamanlar 7T, bazı zamanlar 8T bazı zamanlar ise 11T'ye kadar olan verileri kullanmam gerekebiliyor. Ama en son 15T'ye kadar yapabiliyorsak bu en iyisi olur. İstersen 15T veri alacak kadar sayfaya Sheet girişi yapayım.

Bir de bunu yapış şeklinizi öğrenmem mümkün mü?
Çünkü üzerinde değişikilik yapılması gerektiğinde ne yapacağımı bilememek hiç de hoş değil. Excelde formüllerle aram iyidir. Ancak kod noktasında çok da iyi değilim. Bu tabloya makro kaydederek kodları açtım ve inceledim ilk defa.

İkinci olarak da Sheetlerdeki veriler ana listeye eklendikten sonra 1.olarak YÜZDELİK BAŞARI'ya sonra Toplam Girdi'ye göre listeyi büyükten küçüğe süzdürebilir miyiz?

Yardımın için şimdiden ve yeniden teşekkür ediyorum.

 

[fluess]

Yardım

Arkadaşlar yardım edebilecek kimse yok mu?

 

[fluess]

Sayfa isimlerini değiştirmek

For i = 1 To 4
With Sheets("Sheet" & i * 6)
Set rAlan1 = .Range("C11", "C159")
Set rAlan2 = .Range("G11", "G159")
Set rDeger = .Range("E11", "E159")
End With

Arkadaşlar yukarıdaki ifadede sheet*6 isimli sayfalardan 4 tanesinden veri çekilebiliyor.
Ben bunun yerine sheet ler 1,2,3... sıralı gitsin ve 15 tanesinden veri çeksin istiyorum.

For i = 1 To 4 değerini
For i = 1 To 15 yaptığımda hata veriyor.

With Sheets("Sheet" & i * 6) buna uygun olarak ekledğim sayfaların isimlerini de sheet6 nın katları olarak yazıyorum ama hata veriyor. Burada da sheetler 6nın katı değilde sıralı gitsin istersem kodu nasıl değiştirmeliyim.

Kodun tamamı şu şekilde:

Option Explicit
Sub Degerlendir()
Dim rAlan1 As Range, rAlan2 As Range, rDeger As Range
Dim Kisi As String, Hedef As Range
Dim i As Integer, j As Integer, k As Integer
Dim Deger As String, Yon As Integer
Dim d1 As Double, d2 As Double, dben As Double, dkarsi As Double

For i = 1 To 4
With Sheets("Sheet" & i * 6)
Set rAlan1 = .Range("C11", "C159")
Set rAlan2 = .Range("G11", "G159")
Set rDeger = .Range("E11", "E159")
End With

With Sheets("Masa 1")
j = 12
Do
'Degerlendirilen Satır
j = j + 1
Kisi = .Range("B" & j)
If Kisi = "" Then Exit Do
Set Hedef = .Cells(j, i + 2)
'Esles
Yon = 0
For k = 1 To rAlan1.Cells.Count
If rAlan1(k).Text = Kisi Then
Yon = 1
Deger = rDeger(k).Text
Exit For
ElseIf rAlan2(k).Text = Kisi Then
Yon = 2
Deger = rDeger(k).Text
Exit For
End If
Next
'Bulunamadı ?
If Yon = 0 Then
'Bulunamadı
Hedef.ClearContents
Else
'Bulundu, Degeri Isle
Select Case Left(Deger, 1)
Case "1", "+"
d1 = 1
Case "0", "-"
d1 = 0
Case "½"
d1 = 0.5
End Select
Select Case Right(Deger, 1)
Case "1", "+"
d2 = 1
Case "0", "-"
d2 = 0
Case "½"
d2 = 0.5
End Select
'd1 ben, d2 karsi
If Yon = 1 Then
dben = d1
dkarsi = d2
Else
dben = d2
dkarsi = d1
End If
'Sonuc
If dben > dkarsi Then
Hedef.Value = 1
ElseIf dben = dkarsi Then
Hedef.Value = 0.5
Else
Hedef.Value = 0
End If
End If
Loop
End With
Next

MsgBox "Güncellendi", 64
End Sub