• DİKKAT

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

textboxlarda büyükten küçüğe doğru veri sıralama ve verileri alma

ismailozkan4224

ismailozkan4224

Altın Üye
Katılım
22 Kasım 2011
Mesajlar
175
Excel Vers. ve Dili
2007 türkçe
Sa. Arkadaşlar yapmak istediğim okulda bir okul ligi oluşturmak.

Sayfada toplam 500 öğrenci var. A2 den başlayıp A501 de bitiyor.
Bunlardan A2-A251 arası sabahçı, A252-A501 arası öğlenci. Sabahçı ve öğlenciler ayrı ayrı değerlendirilecektir. Combobox tan bir veri seçtiğimde o veri ile ilgili diğer veriler gelecek. Userformdaki üst taraftaki textboxlar sabahçı grubu yani A2-A251 arasının verilerini büyükten küçüğe doğru, Userformdaki alt taraftaki textboxlar öğlenci grubu yani A252-A501 arasının verilerini büyükten küçüğe doğru sıralayacak. Sıralama işlemi yarışmalardan alınan puanlara göre yapılıyor. Yani G-CE sütunları arasında. Her sınıf için 50 satır düşünülmüştür. Sabahçı grup için 5 sınıf 250 satır, öğlenci grup için 5 sınıf 250 satır. User formun en sağındaki iki sıra textboxta yani 41-50 arasında öğrencilerin okul numaraları (D sütunu) , 51-60 arasındaki textboxlarda ise sınıf puanları (CF sütunu) verileri olacak.
Birçoğunu yaptım ancak dizi ve döngülerde sıkıntı oluşuyor. Ya da verileri istenilen gibi alamıyor. Yardımcı olursanız sevinirim.
 

Ekli dosyalar

Son düzenleme:
Merhaba
"Her sınıf için 50 satır düşünülmüştür" ifadenize göre her sınıfın birincisimi alınacak?
Eğer öyle değilse aşağıdaki gibi olabilir.

Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim by As Variant
  Dim i As Integer, f As Integer, a As Integer
  Dim t, x, n
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0
For a = 2 To 251 Step 249
 Set alan = Range(Cells(a, sut), Cells(a + 249, sut))
 by = Array(CDbl(Wf.Large(alan, 1)), CDbl(Wf.Large(alan, 2)), CDbl(Wf.Large(alan, 3)), CDbl(Wf.Large(alan, 4)), CDbl(Wf.Large(alan, 5)))
 For Each t In alan
 x = Empty
 For n = 0 To UBound(by)
If CDbl(t.Value) = by(n) Then x = n + 1: Exit For
Next
If IsEmpty(x) = False Then
Controls("TextBox" & x + f) = t.Value
Controls("TextBox" & 10 + x + f) = Cells(t.Row, "B")
Controls("TextBox" & 20 + x + f) = Cells(t.Row, "C")
Controls("TextBox" & 30 + x + f) = Cells(t.Row, "E")
Controls("TextBox" & 40 + x + f) = Cells(t.Row, "D")
Controls("TextBox" & 50 + x + f) = Cells(t.Row, "CF")
End If
Next
  f = 5
  Next
End Sub[/SIZE]
 
PLİNT' Alıntı:
Merhaba
"Her sınıf için 50 satır düşünülmüştür" ifadenize göre her sınıfın birincisimi alınacak?
Eğer öyle değilse aşağıdaki gibi olabilir.

Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim by As Variant
  Dim i As Integer, f As Integer, a As Integer
  Dim t, x, n
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0
For a = 2 To 251 Step 249
 Set alan = Range(Cells(a, sut), Cells(a + 249, sut))
 by = Array(CDbl(Wf.Large(alan, 1)), CDbl(Wf.Large(alan, 2)), CDbl(Wf.Large(alan, 3)), CDbl(Wf.Large(alan, 4)), CDbl(Wf.Large(alan, 5)))
 For Each t In alan
 x = Empty
 For n = 0 To UBound(by)
If CDbl(t.Value) = by(n) Then x = n + 1: Exit For
Next
If IsEmpty(x) = False Then
Controls("TextBox" & x + f) = t.Value
Controls("TextBox" & 10 + x + f) = Cells(t.Row, "B")
Controls("TextBox" & 20 + x + f) = Cells(t.Row, "C")
Controls("TextBox" & 30 + x + f) = Cells(t.Row, "E")
Controls("TextBox" & 40 + x + f) = Cells(t.Row, "D")
Controls("TextBox" & 50 + x + f) = Cells(t.Row, "CF")
End If
Next
  f = 5
  Next
End Sub[/SIZE]
Genişletmek için tıkla ...

teşekkür ederim plint. ama her sınıfın birincisi alınacak. dosyayı inceleyebilirseniz sevinirim.her sınıfın birincisi alınacak ve bunlar büyükten küçüğe doğru sıralanacak. bu kısmı hallettim gibi ama 5. lerde sıkıntı çıkarıyor. yani bir dizi hatası ya da eksiği var.
 
combobox kodu aşağıdaki gibidir.
Private Sub ComboBox1_Change()

Dim i As Byte, a As Double, b As Integer, sut As Integer, sat As Long
Dim Wf As WorksheetFunction, alan As RANGE, S2 As Worksheet, dizi()
Dim c As Double, s As Byte, k As Byte, j As Byte, t As Byte, z As Byte

Set Wf = WorksheetFunction
sut = ComboBox1.ListIndex + 7
ReDim dizi(1 To 5, 1 To 5)

For i = 1 To 60
Controls("TextBox" & i) = ""
Next i
If ComboBox1.Value = "" Then Exit Sub

sat = 1
For i = 1 To 10

Set alan = RANGE(Cells(sat + 1, sut), Cells(sat + 50, sut))

a = Wf.Max(alan)
b = sat + 1

If Wf.CountIf(alan, a) > 0 Then
b = Wf.Match(a, alan, 0) + sat
End If

dizi(i, 1) = a
dizi(i, 2) = Cells(b, "B")
dizi(i, 3) = Cells(b, "C")
dizi(i, 4) = Cells(b, "E")
dizi(i, 5) = Cells(b, "CF")
sat = sat + 50

t = 0
If i = 5 Then

If z > 0 Then t = 5

For j = 1 To 5

c = Wf.Large(dizi, j)
Controls("TextBox" & j + t) = c

s = 0
For k = 1 To 5
If c = dizi(k, 1) Then
If Controls("TextBox" & j + 10 + s + t) = "" Then
Controls("TextBox" & j + 10 + s + t) = dizi(k, 2)
Controls("TextBox" & j + 20 + s + t) = dizi(k, 3)
Controls("TextBox" & j + 30 + s + t) = dizi(k, 4)
Controls("TextBox" & j + 50 + s + t) = dizi(k, 5)

s = s + 1
End If
End If
Next k

Next j
i = 1
z = z + 1
Erase dizi

ReDim dizi(1 To 5, 1 To 5)
End If
If z > 1 Then Exit For
Next i


End Sub
 
d sütununun değerlerini aldıramadım.
bir de şöyle bir satır olması lazım gibi ama yapamadım.
Controls("TextBox" & j + 40 + s + t) = dizi(k, 5) (dizi kısmı ve döngü nasıl olmalı?)
 
Son düzenleme:
Merhaba
Yukarıdaki kodlarınızla;
mesela "Combobox" ta birinci satır "en güzel, en doğal fotoğraf" seçildiğinde (üst kısımdaki "Textbox1" de) birinci 331. satırdaki puan çıkıyor.
Aşağıdaki gibi deneyelim, iki sınıfta aynı en yüksek puanı alan olma ihtimali varsa eklemeler yaparız
Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim f As Integer, v As Integer, v2 As Integer, a As Integer, a2 As Integer
Dim sut As Long
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0: v = 2: v2 = 51
For a = 1 To 2
Dim Lst(4)
Dim Lst2(4)
For a2 = 0 To 4
Set alan = Range(Cells(v, sut), Cells(v2, sut))
Lst(a2) = Wf.Large(alan, 1)
Lst2(a2) = Wf.Match(Wf.Large(alan, 1), alan, 0) + v - 1
v = v + 50: v2 = v2 + 50
Next
For a2 = 0 To 4
x = Wf.Match(Wf.Large(Lst, a2 + 1), Lst, 0) - 1
Controls("TextBox" & a2 + 1 + f) = Cells(Lst2(x), sut)
Controls("TextBox" & 10 + a2 + 1 + f) = Cells(Lst2(x), "B")
Controls("TextBox" & 20 + a2 + 1 + f) = Cells(Lst2(x), "C")
Controls("TextBox" & 30 + a2 + 1 + f) = Cells(Lst2(x), "E")
Controls("TextBox" & 40 + a2 + 1 + f) = Cells(Lst2(x), "D")
Controls("TextBox" & 50 + a2 + 1 + f) = Cells(Lst2(x), "CF")
Next
Erase Lst: Erase Lst2
f = 5
v = 252: v2 = 301
Next

End Sub[/SIZE]
Ayrıca
Tarih ve saat için döngülü kodlar yerine PC belleğini daha az kulanan ek dosyadaki kodları kullanın;
Değişen/eklenen kodlar "modül3" ve "FORM" sayfalarında
http://s6.dosya.tc/server11/bjx826/Okul-Ligi-2018_2.zip.html
 
PLİNT' Alıntı:
Merhaba
Yukarıdaki kodlarınızla;
mesela "Combobox" ta birinci satır "en güzel, en doğal fotoğraf" seçildiğinde (üst kısımdaki "Textbox1" de) birinci 331. satırdaki puan çıkıyor.
Aşağıdaki gibi deneyelim, iki sınıfta aynı en yüksek puanı alan olma ihtimali varsa eklemeler yaparız
Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim f As Integer, v As Integer, v2 As Integer, a As Integer, a2 As Integer
Dim sut As Long
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0: v = 2: v2 = 51
For a = 1 To 2
Dim Lst(4)
Dim Lst2(4)
For a2 = 0 To 4
Set alan = Range(Cells(v, sut), Cells(v2, sut))
Lst(a2) = Wf.Large(alan, 1)
Lst2(a2) = Wf.Match(Wf.Large(alan, 1), alan, 0) + v - 1
v = v + 50: v2 = v2 + 50
Next
For a2 = 0 To 4
x = Wf.Match(Wf.Large(Lst, a2 + 1), Lst, 0) - 1
Controls("TextBox" & a2 + 1 + f) = Cells(Lst2(x), sut)
Controls("TextBox" & 10 + a2 + 1 + f) = Cells(Lst2(x), "B")
Controls("TextBox" & 20 + a2 + 1 + f) = Cells(Lst2(x), "C")
Controls("TextBox" & 30 + a2 + 1 + f) = Cells(Lst2(x), "E")
Controls("TextBox" & 40 + a2 + 1 + f) = Cells(Lst2(x), "D")
Controls("TextBox" & 50 + a2 + 1 + f) = Cells(Lst2(x), "CF")
Next
Erase Lst: Erase Lst2
f = 5
v = 252: v2 = 301
Next

End Sub[/SIZE]
Ayrıca
Tarih ve saat için döngülü kodlar yerine PC belleğini daha az kulanan ek dosyadaki kodları kullanın;
Değişen/eklenen kodlar "modül3" ve "FORM" sayfalarında
http://s6.dosya.tc/server11/bjx826/Okul-Ligi-2018_2.zip.html
Genişletmek için tıkla ...

selamün aleyküm. sayın plint öncelikle yapmış olduğunuz yardım için teşekkür ederim. harika olmuş. ancak şuan ki sıkıntı alan kısmı boş ise hata veriyor. yani sıralama yapacağı rakamı bulamayınca hata veriyor. aşağıdaki koda nasıl bir ilave sorun çözülebilir. Lst(a2) = Wf.Large(alan, 1) ' bu kısım hata veriyor
şimdiden teşekkür ederim.

Private Sub ComboBox1_Change()
Dim f As Integer, v As Integer, v2 As Integer, a As Integer, a2 As Integer
Dim sut As Long
Dim Wf As WorksheetFunction, alan As Range
Set Wf = WorksheetFunction
sut = ComboBox1.ListIndex + 7
For i = 1 To 60
Controls("TextBox" & i) = ""
Next i
If ComboBox1.Value = "" Then Exit Sub
f = 0: v = 2: v2 = 51
For a = 1 To 2
Dim Lst(4)
Dim Lst2(4)
For a2 = 0 To 4
Set alan = Range(Cells(v, sut), Cells(v2, sut))

Lst(a2) = Wf.Large(alan, 1) ' bu kısım hata veriyor
Lst2(a2) = Wf.Match(Wf.Large(alan, 1), alan, 0) + v - 1
v = v + 50: v2 = v2 + 50
Next
For a2 = 0 To 4
x = Wf.Match(Wf.Large(Lst, a2 + 1), Lst, 0) - 1
Controls("TextBox" & a2 + 1 + f) = Cells(Lst2(x), sut)
Controls("TextBox" & 10 + a2 + 1 + f) = Cells(Lst2(x), "B")
Controls("TextBox" & 20 + a2 + 1 + f) = Cells(Lst2(x), "C")
Controls("TextBox" & 30 + a2 + 1 + f) = Cells(Lst2(x), "E")
Controls("TextBox" & 40 + a2 + 1 + f) = Cells(Lst2(x), "CG") '"D"
Controls("TextBox" & 50 + a2 + 1 + f) = Cells(Lst2(x), "CF")
Next
Erase Lst: Erase Lst2
f = 5
v = 252: v2 = 301
Next

End Sub
 
Ya da iki tane ayrı sınıftan ayrı ayrı öğrenciler aynı puanı almışsa BİRİNCİSİNİ mükerrer gösteriyor. Diğerini göstermiyor
 
Son düzenleme:
sayın plint bir çözüm öneriniz var mı? puanlar olmayınca hata veriyor. ayrıca aynı puandan başka öğrenci var ise birincisini mükerrer gösteriyor. ikincisini göstermiyor. ilginiz için teşekkür ederim.
 
selamün aleyküm. sayın plint sorunuma bir çözüm bulabildiniz mi? 7. , 8. ve 9. mesajlarım
 
sayın plint öneriniz var mı? çözüm üretemedim. yardım ederseniz sevinirim...
 
Merhaba
Kusuruma bakmayınız İsmail bey, bu konuda mesajıma dönüşünüz birkaç gün sonra olunca mesajlarınız gözümden kaçmış, özelden mesaj atsaydınız keşke;
Ek dosyayı incelermisiniz?
Ayrıca "1" adlı sayfa "Range("U1:U5") aralığındaki gibi bir durum, olurmu bilmiyorum ama bu ihtimal içinde ek yapmaya çalıştım.
http://s4.dosya.tc/server5/0fnuvt/Okul-Ligi-2018_3.zip.html
Değişen bölümler aşağıdaki kırmızı satırlar
Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim f As Integer, v As Integer, v2 As Integer, a As Integer, a2 As Integer
Dim sut As Long
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0: v = 2: v2 = 51
For a = 1 To 2
Dim Lst(4)
Dim Lst2(4)
For a2 = 0 To 4
Set alan = Range(Cells(v, sut), Cells(v2, sut))
[COLOR="Red"]sy = Wf.CountIf(alan, ">=0")
If sy > 0 Then
If sy > a2 + 1 Then[/COLOR]
Lst(a2) = Wf.Large(alan, 1)

Lst2(a2) = Wf.Match(Wf.Large(alan, 1), alan, 0) + v - 1
[COLOR="Red"]Else
Lst(a2) = ""
Lst2(a2) = ""[/COLOR]
End If: End If
v = v + 50: v2 = v2 + 50
Next
[COLOR="Red"]If UBound(Lst) > 0 Then
For a2 = 0 To UBound(Lst)
If Lst(a2) <> "" Then[/COLOR]
x = Wf.Match(Wf.Large(Lst, 1), Lst, 0) - 1
Controls("TextBox" & a2 + 1 + f) = Cells(Lst2(x), sut)
Controls("TextBox" & 10 + a2 + 1 + f) = Cells(Lst2(x), "B")
Controls("TextBox" & 20 + a2 + 1 + f) = Cells(Lst2(x), "C")
Controls("TextBox" & 30 + a2 + 1 + f) = Cells(Lst2(x), "E")
Controls("TextBox" & 40 + a2 + 1 + f) = Cells(Lst2(x), "D")
Controls("TextBox" & 50 + a2 + 1 + f) = Cells(Lst2(x), "CF")
[COLOR="Red"]Lst(x) = -1
End If[/COLOR]
Next
End If
Erase Lst: Erase Lst2
f = 5
v = 252: v2 = 301
Next

End Sub[/SIZE]
Kod: 
[SIZE="2"]Private Sub UserForm_Initialize()
[COLOR="Red"]For a = 7 To Cells(1, Columns.Count).End(xlToLeft).Column - 2
If Cells(1, a).Value <> "" And Cells(1, a).Value <> "0" Then ComboBox1.AddItem Cells(1, a).Value
Next[/COLOR]
 
'....
'....

End Sub[/SIZE]
 
Son düzenleme:
sayın plint öncelikle teşekkür ederim. göndermiş olduğunuz kodda şu satır hata veriyor.

Lst(a2) = Wf.Large(alan, 1)

nedeni ise her 50 satır içinde en az bir rakam bulunmasını istemesi. rakam yoksa her 50 satırın birinin içinde hata veriyor. ki bu kısımdaki hatayı bertaraf etmek için bütün hücreleri başlangıçta sıfır ile doldurdum. boş hücre bırakmadım.
ikinci durum ise ilk 50 satırda varsayalım 85 puan var. aynı puan 60. satırda da varsa 60. satırdaki veriyi göstermiyor ilk ellideki kişiyi mükerrer gösteriyor. aynı puanlı da olsa her 50 satırdaki en büyük veriyi göstermesi lazım.
 
Merhaba
Son dosyada; bahsettiğiniz gibi hataları göremedim ama asıl kayıtların teferruatını siz daha iyi bilirsiniz;
Kodların içerisinden fonksiyonları kaldırarak şöylede yapabiliriz

http://www.dosya.tc/server10/tpnv1k/Okul-Ligi-2018_4.zip.html

Kod: 
[SIZE="2"]Private Sub ComboBox1_Change()
Dim f As Integer, v As Integer, v2 As Integer, a As Integer, a2 As Integer
Dim sut As Long
    Dim Wf As WorksheetFunction, alan As Range
    Set Wf = WorksheetFunction
    sut = ComboBox1.ListIndex + 7
    For i = 1 To 60
        Controls("TextBox" & i) = ""
    Next i
    If ComboBox1.Value = "" Then Exit Sub
f = 0: v = 2: v2 = 51
For a = 1 To 2
ReDim Lst(1 To 5, 1 To 2)
For t = 1 To 5
Set alan = Range(Cells(v, sut), Cells(v2, sut))
For Each b In alan
If IsEmpty(b.Value) = False And IsNumeric(b.Value) = True Then
If Lst(t, 2) < CDbl(b.Value) Then
Lst(t, 2) = CDbl(b.Value)
Lst(t, 1) = b.Row
End If
End If
Next b
v = v + 50: v2 = v2 + 50
Next t
For i = 1 To 5 - 1
For j = i + 1 To 5
If Lst(i, 2) < Lst(j, 2) Then
k = Lst(i, 1)
k2 = Lst(i, 2)
Lst(i, 1) = Lst(j, 1)
Lst(i, 2) = Lst(j, 2)
Lst(j, 1) = k
Lst(j, 2) = k2
End If
Next j
Next i
For j = 5 To 2 Step -1
If Lst(j, 1) = Lst(j - 1, 1) Then Lst(j, 1) = Empty
Next
For a2 = 1 To 5
If IsEmpty(Lst(a2, 1)) = False Then
Controls("TextBox" & a2 + f) = Cells(Lst(a2, 1), sut)
Controls("TextBox" & 10 + a2 + f) = Cells(Lst(a2, 1), "B")
Controls("TextBox" & 20 + a2 + f) = Cells(Lst(a2, 1), "C")
Controls("TextBox" & 30 + a2 + f) = Cells(Lst(a2, 1), "E")
Controls("TextBox" & 40 + a2 + f) = Cells(Lst(a2, 1), "D")
Controls("TextBox" & 50 + a2 + f) = Cells(Lst(a2, 1), "CF")
End If
Next
Erase Lst
f = 5
v = 252: v2 = 301
Next
End Sub[/SIZE]
Kod: 
[SIZE="2"] Private Sub UserForm_Initialize()
For a = 7 To Cells(1, Columns.Count).End(xlToLeft).Column - 2
If Cells(1, a).Value <> "" And Cells(1, a).Value <> "0" Then ComboBox1.AddItem Cells(1, a).Value
Next
Label2.Caption = " ***** " & vbLf & " ***** "
Label3.Caption = " ****** "
End Sub[/SIZE]
 
çok teşekkür ederim sayın plint. harika oldu
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst