Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 31-10-2017, 12:24   #1
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan textboxlarda büyükten küçüğe doğru veri sıralama ve verileri alma

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.
Eklenmiş Dosyalar
Dosya Türü: xls Okul-Ligi-2018-1.xls (684.0 KB, 4 Görüntülenme)

Bu mesaj en son " 31-10-2017 " tarihinde saat 14:51 itibariyle ismailozkan4224 tarafından düzenlenmiştir....
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-10-2017, 17:34   #2
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,247
Excel Vers. ve Dili:
Excel 2010
Varsayılan

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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-10-2017, 18:18   #3
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Alıntı:
PLİNT tarafından gönderildi Mesajı Görüntüle
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
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.
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-10-2017, 18:25   #4
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

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
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-10-2017, 18:49   #5
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

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ı?)

Bu mesaj en son " 31-10-2017 " tarihinde saat 19:17 itibariyle ismailozkan4224 tarafından düzenlenmiştir....
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 07:42   #6
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,247
Excel Vers. ve Dili:
Excel 2010
Varsayılan

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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
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/O...018_2.zip.html
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-11-2017, 07:11   #7
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Alıntı:
PLİNT tarafından gönderildi Mesajı Görüntüle
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
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/O...018_2.zip.html
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
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 06-11-2017, 14:17   #8
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

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

Bu mesaj en son " 06-11-2017 " tarihinde saat 14:28 itibariyle ismailozkan4224 tarafından düzenlenmiştir....
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-11-2017, 10:30   #9
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

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.
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-11-2017, 07:05   #10
ismailozkan4224
Altın Üye
 
Giriş: 22/11/2011
Şehir: konya
Mesaj: 63
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

selamün aleyküm. sayın plint sorunuma bir çözüm bulabildiniz mi? 7. , 8. ve 9. mesajlarım
ismailozkan4224 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 23:01


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden