Kaçıncı değeri bulmak

[Muhammet Okumuş]

Arkadaşlar merhaba,
Üzerinde çalıştığım dosyada yaşadığım probleme çözüm bulmak için sizden yardım istiyorum.
B ve D sütunundaki verileri hafızaya alıyorum. Düşeyara ile sütundaki değerleri buluyorum. Ama bakmak istediğim değerin kaçıncı veri olduğunu ayrı hafızaya almadıktan sonra bulamıyorum. Bunu yapmanın başka yolu var mı? Yoksa benim yaptığım çözüm en iyi yöntem mi?

Sub Kaçıncı()
liste = Range("B3:d14").Value
MsgBox WorksheetFunction.VLookup(Range("F3"), liste, 2, 0)
liste1 = Range("B3:B14").Value
MsgBox WorksheetFunction.Match(Range("F3"), liste1, 0)

End Sub

Kodda liste1 olarak ayrı hafızaya alıyorum ve kaçıncı olduğunu bu şekil buluyorum. Sadece liste verisini kullanarak kaçıncı olduğunu bulmak mümkün mü?

 

[Necdet]

Merhaba Muhammet bey,

Aşağıdaki şekilde kullansanız olmaz mı?

Sub Bul()

    Dim c As Range
    
    Set c = Range("B:B").Find(Range("F3"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        MsgBox "Bulunulan Satır No : " & c.Row & " C Sütunundaki Değer : " & Range("C" & c.Row)
    Else
        MsgBox "Bulunamadı...."
    End If
    
End Sub

 

[Muhammet Okumuş]

Necdet Bey, cevabınız için teşekkür ederim. Ama ben sadece hafızaya aldığım liste verisini kullanarak sonuca ulaşmak istiyorum.

 

[Necdet]

Merhaba,

Aşağıdaki kodda da görüldüğü üzere listeye alındığında bir önceki verdiğim koddaki sonuç ile aynı oldu.
Yani satır sayısı 3 değil, 5.
Bu yöntemde sonuç değişmedi.

Sub Bul()

    Dim c As Range
    Dim Liste As Variant
   
    Set Liste = Range("B3:D14")
    Set c = Liste.Find(Range("F3"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        MsgBox "Bulunulan Satır No : " & c.Row & " C Sütunundaki Değer : " & Range("C" & c.Row)
    Else
        MsgBox "Bulunamadı...."
    End If
   
End Sub

 

[Muhammet Okumuş]

Necdet Bey, cevabınız için teşekkür ederim. Yazdığımı kendimi çok bilmiş veya saygısızlık olarak algılamayın lütfen. Benim ilk mesajda verdiğim kod ile sizin yazmış olduğunuz kod arasında çalışma hızı olarak bir fark var mı? Benim yazdığım kod daha sade ve sonucu o da buluyor. Benim amacım match ile liste1 verisine gerek kalmadan liste verisinden sonuca ulaşmak. Sizin kod hafızanın içerisindeki bütün sütunlarda da arıyor.

 

[Muhammet Okumuş]

Sub Şube_Sınav_Tüm2()
Application.ScreenUpdating = False
Range("AC6:ZZ6").Borders.LineStyle = xlNone
Range("Q8:ZZ1000").Borders.LineStyle = xlNone
Range("AC5:ZZ6,Q8:ZZ1000").ClearContents
Range("Q8:ZZ1000").Interior.ColorIndex = xlNone
Range("AC6:ZZ6").Interior.ColorIndex = xlNone
'Range("Q8:ZZ1000 ").Font.ColorIndex = 1
son = Sheets("Data").Cells(Rows.Count, "B").End(3).Row
liste = Sheets("Data").Range("B4:Q" & son).Value
son1 = Sheets("Liste").Cells(Rows.Count, "B").End(3).Row
sınıf_liste = Sheets("Liste").Range("B3:d" & son1).Value
no_liste = Sheets("Liste").Range("B3:B" & son1).Value
son1 = Sheets("Sınavlar").Cells(Rows.Count, "B").End(3).Row
sınav = Sheets("Sınavlar").Range("B3:L" & son1).Value

şube = Range("B6").Value
tur = Range("D6").Value

Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
y = WorksheetFunction.Max(Sheets("Data").Range("B3:B10000"))
ReDim tablo2(1 To 2, 1 To UBound(liste))
ReDim tablo(1 To UBound(liste), 1 To 13 + y)

For i = UBound(liste) To 1 Step -1
If IsError(Application.Match(liste(i, 3), no_liste, 0)) Then GoTo 111
If WorksheetFunction.VLookup(liste(i, 3), sınıf_liste, 3, 0) = şube And (WorksheetFunction.VLookup(liste(i, 1), sınav, 6, 0) = tur Or tur = "") Then

If Not dic2.exists(liste(i, 1)) Then
m = m + 1
dic2.Add liste(i, 1), m
tablo2(1, m) = liste(i, 1)
tablo2(2, m) = WorksheetFunction.VLookup(liste(i, 1), sınav, 5, 0)
End If

End If
111
Next
If m = 0 Then Exit Sub
Range("AC5").Resize(2, m) = tablo2

sınav1 = Range("AC5:ZZ5").Value
For i = UBound(liste) To 1 Step -1
If IsError(Application.Match(liste(i, 1), sınav1, 0)) Then GoTo 100
If IsError(Application.Match(liste(i, 3), no_liste, 0)) Then GoTo 100
If Not dic.exists(liste(i, 3)) Then
n = n + 1
dic.Add liste(i, 3), n
tablo(n, 1) = n
tablo(n, 2) = liste(i, 3)
tablo(n, 3) = liste(i, 4)
tablo(n, 9) = liste(i, 14)
tablo(n, 10) = liste(i, 15)
tablo(n, 11) = liste(i, 16)
tablo(n, 8) = liste(i, 14) + liste(i, 15) + liste(i, 16)
r = Application.Match(liste(i, 1), sınav1, 0)
tablo(dic.Item(liste(i, 3)), 12 + r) = liste(i, 9)
Else
tablo(dic.Item(liste(i, 3)), 9) = tablo(dic.Item(liste(i, 3)), 9) + liste(i, 14)
tablo(dic.Item(liste(i, 3)), 10) = tablo(dic.Item(liste(i, 3)), 10) + liste(i, 15)
tablo(dic.Item(liste(i, 3)), 11) = tablo(dic.Item(liste(i, 3)), 11) + liste(i, 16)
tablo(dic.Item(liste(i, 3)), 8) = tablo(dic.Item(liste(i, 3)), 8) + liste(i, 14) + liste(i, 15) + liste(i, 16)
r = Application.Match(liste(i, 1), sınav1, 0)
tablo(dic.Item(liste(i, 3)), 12 + r) = liste(i, 9)

End If

100
Next


Range("Q8").Resize(n, 12 + y) = tablo

For i = 8 To Cells(Rows.Count, 17).End(3).Row
Cells(i, 22) = WorksheetFunction.Average(Range("AC" & i & ":ZZ" & i))


Next
Range("V8:V1000").NumberFormat = "0.0"
Range("R8:ZZ100").Sort Range("X8"), 2
Range("R8:ZZ100").Sort Range("V8"), 2
Range("AC8:ZZ1000").NumberFormat = "0"
Erase tablo

r = WorksheetFunction.CountA(Range("AC6:ZZ6")) + 28
For i = 8 To Cells(Rows.Count, 17).End(3).Row
If i Mod 2 = 1 Then
Range(Cells(i, "Q"), Cells(i, r)).Interior.Color = 15921906
End If
Next
Columns("T:U").Interior.ColorIndex = xlNone
Columns("W").Interior.ColorIndex = xlNone
Columns("AB").Interior.ColorIndex = xlNone

t = Cells(Rows.Count, 17).End(3).Row
Range("Q8:S" & t).Borders.Color = 14277081
Range("V8:V" & t).Borders.Color = 14277081
Range("X8:AA" & t).Borders.Color = 14277081
Range(Cells(8, "AC"), Cells(t, r)).Borders.Color = 14277081
Range(Cells(6, "AC"), Cells(6, r)).Borders.Color = 14277081
Range(Cells(6, "AC"), Cells(6, r)).Interior.Color = 12611584
Range("AC5:ZZ5").ClearContents
End Sub

Bu gibi uzun kodlarla çalışıyorum. Amacım hem hafızaya alınan veriyi azaltmak hem de

 

[Necdet]

Merhaba,

Hız olarak bilemiyorum, uzun verilerde denemek gerek, arama işini belirlenen aralıkta da yapılabilir, ikinci kodu o nedenle vermiştim. Ama sonuç değişmedi.

 

[Erdem Akdemir]

Aşağıdaki gibi kullanabilirsiniz.

MsgBox WorksheetFunction.Match(Range("F3"), Application.Index(Application.Transpose(liste), 1), 0)

 

[Muhammet Okumuş]

Sn Erdem Bey,
Cevabınız için çok teşekkür ederim. Kod yapısı oldukça esnek. İstediğimiz sütunda arama yapmaya imkan veriyor. Bu kodu çalışmalarımda oldukça kullanacağımı düşünüyorum. Tekrardan çok teşekkür ederim.

 

[Korhan Ayhan]

Veri yığını büyükse sıkıntı çıkarabilir.

 

[Muhammet Okumuş]

Veri yığını her geçen gün artıyor. Ama 10.000 satırı bulmaz. Sütun olarak maksimum 50 sütun.

 

[Korhan Ayhan]

Bu da alternatif olsun;

Sub Kaçıncı()
    Dim Liste As Range
    Set Liste = Range("B3:D14")
    MsgBox WorksheetFunction.VLookup(Range("F3"), Liste, 2, 0)
    MsgBox WorksheetFunction.Match(Range("F3"), Liste.Columns(1), 0)
    Set Liste = Nothing
End Sub

 

[Muhammet Okumuş]

Korhan Bey cevabınız için çok teşekkür ederim. Bu hali çok sade. Bu yapı da oldukça esnek.

 

[Orion1]

Korhan bey #12 tagda verdiğiniz kodlarda hata aldım.Msgbox satırında hata verdi.
Dosyayı ekledim.

 

[Muhammet Okumuş]

Evren Bey, dosyanızda B sütununda C5 diye veri yok. Hatanın kaynağı o. Korhan Bey, Vlookup ile değil de Match ile çalışma yaptı. Vlookup benim paylaştığım dosyadaki bir koddu.

 

[Orion1]

Evren Bey, dosyanızda B sütununda C5 diye veri yok. Hatanın kaynağı o. Korhan Bey, Vlookup ile değil de Match ile çalışma yaptı. Vlookup benim paylaştığım dosyadaki bir koddu.

Evren Bey, dosyanızda B sütununda C5 diye veri yok. Hatanın kaynağı o. Korhan Bey, Vlookup ile değil de Match ile çalışma yaptı. Vlookup benim paylaştığım dosyadaki bir koddu.

C ve D sütunlarında var.

 

[Orion1]

evet.b sütununda olmalıymış.Teşekkür ederim.

 

[Korhan Ayhan]

Neden alternatif önerdim...

Application.Index ve Application.Transpose komutları 65.536 satırdan büyük verilerde hata verecektir. En azından benim denemelerimde bu şekilde sonuç veriyor. Bu.komutlar sanırım eski excel versiyonlarını göre kurgulanmışlar. Daha sonrada microsoft bunları güncellemeyi sanırım atladı. Bu sebeple dikkatli kullanmak gerekiyor.

 

[Muhammet Okumuş]

Teşekkür ederim Korhan Bey.