Sütunlarda yazılı en küçük değeri bulmak..

E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Merhabalar;

Soru aşağıda... İlgilenen tüm arkadaşlara şimdiden teşekkürler.

"Düğmeye basıldığında girilecek [1..4] arası rakama göre

H-K-N-Q sütünlarına bakarak;
G-J-M-P sütunlarındaki en küçük değerleri;

Örnek verilen MsgBox dakine benzer biçimde verilmesini,

eğer girilen sayı yoksa ""Yoktur"" demesini istiyoruz."

Örnek dosya da Ek'te...

Saygılarımla...
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ekte.:cool:
Kod: 
Sub kucuk_ara()
Dim deg As Byte, i As Byte, k As Byte
Min = InputBox("Sayı Grubu değerini giriniz...[1-2-3-4]", , 2)
For i = 8 To 17 Step 3
deg = 100
    For k = 1 To 13
    If Cells(k, i).Value = CInt(Min) Then
        If Cells(k, i - 1).Value < deg Then
            If i = 8 Then
                min1 = Cells(k, i - 1).Value
                min1adr = Cells(k, i - 1).Address
                deg = Cells(k, i - 1).Value
            End If
            If i = 11 Then
                min2 = Cells(k, i - 1).Value
                min2adr = Cells(k, i - 1).Address
                deg = Cells(k, i - 1).Value
            End If
            If i = 14 Then
                min3 = Cells(k, i - 1).Value
                min3adr = Cells(k, i - 1).Address
                deg = Cells(k, i - 1).Value
            End If
            If i = 17 Then
                min4 = Cells(k, i - 1).Value
                min4adr = Cells(k, i - 1).Address
                deg = Cells(k, i - 1).Value
            End If
        End If
    End If
    Next k
Next i
If min1adr = "" Then min1adr = "YOKTUR"
If min2adr = "" Then min2adr = "YOKYUR"
If min3adr = "" Then min3adr = "YOKTUR"
If min4adr = "" Then min4adr = "YOKTUR"
MsgBox "G sütununda [ " & min1adr & " ] te " & min1 & vbLf & _
"J sütununda [ " & min2adr & " ] te " & min2 & vbLf & _
"M sütununda [ " & min3adr & " ] te " & min3 & vbLf & _
"P sütununda [ " & min4adr & " ] te " & min4 & vbLf & "BULUNMUŞTUR.", vbOKOnly
            
End Sub
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Say&#305;n Evren Gizlen &#231;ok te&#351;ekk&#252;r ederim. Elinize sa&#287;l&#305;k.. Tam istedi&#287;im gibi..

Acizane; For Next d&#246;ng&#252;s&#252; kurmadan yapmam&#305;z m&#252;mk&#252;n olmazm&#305;yd&#305;. Merak&#305;mdan soruyorum....
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
ECYavuz' Alıntı:
Sayın Evren Gizlen çok teşekkür ederim. Elinize sağlık.. Tam istediğim gibi..

Acizane; For Next döngüsü kurmadan yapmamız mümkün olmazmıydı. Merakımdan soruyorum....
Genişletmek için tıkla ...
Kurduğum döngü bu iş için en uygun olanıydı.
For next ile kodları oturtmak çok zorlaşırdı.:cool:
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Çok Teşekkürler

Evren Gizlen' Alıntı:
Kurduğum döngü bu iş için en uygun olanıydı.
For next ile kodları oturtmak çok zorlaşırdı.:cool:
Genişletmek için tıkla ...
Yanlış anlatmadıysam sanırım zaten çözüme For...next döngüsü ile ulaştık.

Arama işlemini örneğin Find komutu kullanarak veya

For k = 1 To 13
......
......
......
Next K

döngüsünü kullanmadan yapabilirmiydik diye sormuştum..

saygılarımla...
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
ECYavuz' Alıntı:
Yanlış anlatmadıysam sanırım zaten çözüme For...next döngüsü ile ulaştık.

Arama işlemini örneğin Find komutu kullanarak veya

For k = 1 To 13
......
......
......
Next K

döngüsünü kullanmadan yapabilirmiydik diye sormuştum..

saygılarımla...
Genişletmek için tıkla ...
For next döngüsü ile çözdüğünüz kodları yollarmısınız.Merak ettimde.
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Sayın Evren dediğim gibi yanlış anlatıyorum herhalde aşağıda yer alan For....Next döngüsünü kullanarak çözüme ulaşan zaten sizsiniz. Kodları uygulayan sizsiniz açıkcası.

Bunun içinde size çok teşekkür ederim. Ben sizin yaptığınız çözümü zaten kullanacağım.. Merakım; örnek olarak,

x = Sheets("sayfa1").Range("H:H").Cells.Find(what:=Min, LookIn:=xlValues).Row

gibi Find kullanarak yapabilirmiyiz??? şeklinde sordum...

Evren Gizlen' Alıntı:
For next döngüsü ile çözdüğünüz kodları yollarmısınız.Merak ettimde.
Genişletmek için tıkla ...
Sizin gönderdiğiniz kodlar: For....Next döngüsü kullanılarak çözüme ulaştırıyor.

For i = 8 To 17 Step 3
deg = 100
For k = 1 To 13
If Cells(k, i).Value = CInt(Min) Then
If Cells(k, i - 1).Value < deg Then
If i = 8 Then
min1 = Cells(k, i - 1).Value
min1adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 11 Then
min2 = Cells(k, i - 1).Value
min2adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 14 Then
min3 = Cells(k, i - 1).Value
min3adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 17 Then
min4 = Cells(k, i - 1).Value
min4adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
End If
End If
Next k
Next i
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Çok affedersiniz benim aklım for each döngüsüne gittide.Ondan sormuştum.
For each döngüsünü burada kullanmak pek uygun olmuyorda.:) :)
Find komutu burada işe yaramaz.
Zira, if ile sorgulama yapılıyor.:cool:
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Tamam &#252;stat... Te&#351;ekk&#252;rler..(Orion2) Evren Gizlen karde&#351;im....
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,680
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Tek kelime ile harika....

Korhan Ayhan' Alıntı:
Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.
Genişletmek için tıkla ...
Sayın Korhan Ayhan öncelikle gece gönderdiğiniz kod için şimdi teşekkür edebiliyorum. Sağolun ve kusura bakmayın.

Aslında söylenecek çok söz var ama şu yazacaklarım sanırım düşüncelerimi ifade edebilir.

Programımda kullanacağım bir konuda danıştım, sonuca ulaşabilecek birden çok yolu sanki yana yana konuşuyormuş gibi olabildiğince hızla alabildim. Bu çok güzel bir duygu ve EKİP ÇALIŞMASI hazını bize verdiği için Excel.Web.Tr ye ve tabii ki sizlere çok teşekkürler.

Aşağıda aynı konuda aynı sonucu verebilen üç değişik kodu bilgilerinize sunuyorum. Açıkcası Sayın Evren Gizlen ve Korhan Ayhan üstatların kodları çok daha hızlı ama çözüm çözümdür...

Saygılarımla....
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Sayın Evren Gizlen'in çözümü;

Sub kucuk_ara()
'Evren Gizlen tarafından hazırlanmıştır.
Dim deg As Byte, i As Byte, k As Byte
Min = InputBox("Sayı Grubu değerini giriniz...[1-2-3-4]", , 2)
For i = 8 To 17 Step 3
deg = 100
For k = 1 To 13
If Cells(k, i).Value = CInt(Min) Then
If Cells(k, i - 1).Value < deg Then
If i = 8 Then
min1 = Cells(k, i - 1).Value
min1adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 11 Then
min2 = Cells(k, i - 1).Value
min2adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 14 Then
min3 = Cells(k, i - 1).Value
min3adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
If i = 17 Then
min4 = Cells(k, i - 1).Value
min4adr = Cells(k, i - 1).Address
deg = Cells(k, i - 1).Value
End If
End If
End If
Next k
Next i
If min1adr = "" Then min1adr = "YOKTUR"
If min2adr = "" Then min2adr = "YOKYUR"
If min3adr = "" Then min3adr = "YOKTUR"
If min4adr = "" Then min4adr = "YOKTUR"
MsgBox "G sütununda [ " & min1adr & " ] te " & min1 & vbLf & _
"J sütununda [ " & min2adr & " ] te " & min2 & vbLf & _
"M sütununda [ " & min3adr & " ] te " & min3 & vbLf & _
"P sütununda [ " & min4adr & " ] te " & min4 & vbLf & "BULUNMUŞTUR.", vbOKOnly
End Sub


Çok Teşekkürler...
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Sayın Korhan Ayhan'ın çözümü;

Sub KÜÇÜK_BUL()
SAYI = InputBox("Sayı grubu değerini giriniz !" & Chr(10) & Chr(10) & "[1-2-3-4]", , 2)
If SAYI = "" Or SAYI = False Then Exit Sub
If SAYI < 1 Or SAYI > 4 Then
MsgBox "Lütfen 1-2-3-4 değerlerinden birisini giriniz !", vbCritical, "DİKKAT !"
Exit Sub
End If
If (WorksheetFunction.CountIf([H1:H13], SAYI) + _
WorksheetFunction.CountIf([K1:K13], SAYI) + _
WorksheetFunction.CountIf([N1:N13], SAYI) + _
WorksheetFunction.CountIf([Q1:Q13], SAYI)) = 0 Then
MsgBox "Girdiğiniz sayı grubu bulunamamıştır !", vbExclamation, "DİKKAT !"
Else
MİNG = Evaluate("=MIN(IF(H1:H13=" & SAYI & ",ROW(1:13)))")
MİNJ = Evaluate("=MIN(IF(K1:K13=" & SAYI & ",ROW(1:13)))")
MİNM = Evaluate("=MIN(IF(N1:N13=" & SAYI & ",ROW(1:13)))")
MİNP = Evaluate("=MIN(IF(Q1:Q13=" & SAYI & ",ROW(1:13)))")
If MİNG = 0 Then
MESAJ = "G sütununda yoktur !" & vbCrLf
Else
MESAJ = "G" & MİNG & " hücresinde " & Range("G" & MİNG) & " olarak" & vbCrLf
End If
If MİNJ = 0 Then
MESAJ = MESAJ & vbCrLf & "J sütununda yoktur !" & vbCrLf
Else
MESAJ = MESAJ & vbCrLf & "J" & MİNJ & " hücresinde " & Range("J" & MİNJ) & " olarak" & vbCrLf
End If
If MİNM = 0 Then
MESAJ = MESAJ & vbCrLf & "M sütununda yoktur !" & vbCrLf
Else
MESAJ = MESAJ & vbCrLf & "M" & MİNM & " hücresinde " & Range("M" & MİNM) & " olarak" & vbCrLf
End If
If MİNP = 0 Then
MESAJ = MESAJ & vbCrLf & "P sütununda yoktur !" & vbCrLf
Else
MESAJ = MESAJ & vbCrLf & "P" & MİNP & " hücresinde " & Range("P" & MİNP) & " olarak" & vbCrLf
End If
MsgBox SAYI & " değeri H-K-M-Q sütunlarında arandı." & vbCrLf & vbCrLf & MESAJ & vbCrLf & "bulunmuştur !", vbInformation
End If
End Sub

Çok teşekkürler...
 
E

ECYavuz

Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Bu da For Each....next döngüsü kullanılarak yapılan bir örnek...

Sub Düğme1_Tıklat()
Columns(1).ClearContents
Min = InputBox("Sayı Grubu değerini giriniz...[1-2-3-4]", , 2)
With Sayfa1
For Each alan1 In .Range("H:H")
If CInt(alan1) = CInt(Min) Then
alan11 = alan1(1, 1).Cells(1, 0).Value
[a65536].End(3)(2, 1) = alan11
deger1% = Application.WorksheetFunction.Small([a:a], 1)
End If
Next alan1
Columns(1).ClearContents
For Each alan2 In .Range("K:K")
If CInt(alan2) = CInt(Min) Then
alan22 = alan2(1, 1).Cells(1, 0).Value
[a65536].End(3)(2, 1) = alan22
deger2% = Application.WorksheetFunction.Small([a:a], 1)
End If
Next alan2
Columns(1).ClearContents
For Each alan3 In .Range("N:N")
If CInt(alan3) = CInt(Min) Then
alan33 = alan3(1, 1).Cells(1, 0).Value
[a65536].End(3)(2, 1) = alan33
deger3% = Application.WorksheetFunction.Small([a:a], 1)
End If
Next alan3
Columns(1).ClearContents
For Each alan4 In .Range("Q:Q")
If CInt(alan4) = CInt(Min) Then
alan44 = alan4(1, 1).Cells(1, 0).Value
[a65536].End(3)(2, 1) = alan44
deger4% = Application.WorksheetFunction.Small([a:a], 1)
End If
Next alan4
End With
Columns(1).ClearContents
MsgBox Min & " Değeri H-K-M-Q sütunlarında arandı." & vbCrLf & vbNewLine & _
"G sütununda " & deger1 & " olarak" & vbCrLf & _
"J sütununda " & deger2 & " olarak" & vbCrLf & _
"M sütununda " & deger3 & " olarak" & vbCrLf & _
"P sütununda " & deger4 & " olarak" & vbCrLf & vbNewLine & _
"En Küçük Karşılıkları Bulunmuştur..." & vbCr & Chr(13), vbInformation, "www.excelvba.net"
End Sub

İçlerinde en yavaş çalışanı bu olsa da Çok Teşekkürler...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst