döngü ve sıralama bir arada yardımcı olurmusunuz

[doors1]

arkadaşlar A1,A2,A3 hücrelerine girdiğim sayıları D1 sütununa gireceğim bir sayıya kadar sırayla 1'e,2'ye,3'e ....n'e bölecek ve büyükten küçüğe sıralayacak.en büyük n kadar sayıyı belirleyerek bu sayıların kaç tanesinin A1 hücresindeki sayının, kaç tanesinin A2 hücresindeki sayının, kaç tanesinin A3 hücresindeki sayının bölünmesiyle oluştuğunu belirleyerek A1 ile ilgili sayıyı B1'e, A2 ile ilgili olanı B2'ye, A3 ile ilgili olanı B3'e yazacak.nasıl yapabilirim işin içinden çıkamadım.

 

[mancubus]

D1'deki n 20 olsun.
A1, A2, A3'teki sayılar 1'den 20'ye kadar ayrı ayrı bölünsün. 60 adet bölüm çıkar. en büyük n tanesini, yani 20 tanesini B1, B2 ve B3'e nasıl yazıyoruz?

örnek bir dosya eklerseniz daha iyi olur. bir tarafta ham veriler olsun. bir tarafta da çalışma sonrası ulaşmayı hedeflediğiniz sonuçlar olsun. daha aydınlatıcı olur.

 

[doors1]

her sayı 1 den 20 ye kadar bölünecek ve 60 tane sayı olusacak. bu sayılar makronun hafızasında olacak bir yere yazılmayacak.bunlardan en büyük 20 tanesini tespit ederek kaç tanesi A1 deki sayının bölünmesi ile olusuyorsa B1 hücresine bunu yazıcak. B2 ve B3 hücresinede tespit edilen en büyük 20 sayı içerisinde A2 ve A3 sayılarının bölünmesiyle oluşan sayıların kaç tane olduğunu yazacak.

 

[mancubus]

çok meşgul olduğum için fazla ilgilenemedim.

aşağıdaki amatör kod işinizi görür zannediyorum..

Sub bolum_say()

Dim i As Long, say As Long
Dim cll As Range, rng As Range

Range("A1").Interior.Color = vbYellow
Range("A2").Interior.Color = vbCyan
Range("A3").Interior.Color = vbGreen

For i = 1 To Range("D1").Value
    Range("K" & i) = Range("A1") / i
    Range("L" & i) = Range("A2") / i
    Range("M" & i) = Range("A3") / i
Next i

Range("K1:K" & Range("K65536").End(xlUp).Row).Interior.Color = vbYellow
Range("K1:K" & Range("K65536").End(xlUp).Row).Copy
ActiveSheet.Paste Destination:=Range("G1")
Application.CutCopyMode = False

Range("L1:L" & Range("L65536").End(xlUp).Row).Interior.Color = vbCyan
Range("L1:L" & Range("L65536").End(xlUp).Row).Copy
ActiveSheet.Paste Destination:=Range("G65536").End(xlUp).Offset(1, 0)
Application.CutCopyMode = False

Range("M1:M" & Range("M65536").End(xlUp).Row).Interior.Color = vbGreen
Range("M1:M" & Range("M65536").End(xlUp).Row).Copy
ActiveSheet.Paste Destination:=Range("G65536").End(xlUp).Offset(1, 0)
Application.CutCopyMode = False

Range("G1:G" & Range("G65536").End(xlUp).Row).Sort Key1:=Range("G1"), Order1:=xlDescending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

Set rng = Range("G1:G" & Range("D1").Value)

say = 0
For Each cll In rng
    If cll.Interior.Color = vbYellow Then
        say = say + 1
    End If
Next cll
Range("B1") = say

say = 0
For Each cll In rng
    If cll.Interior.Color = vbCyan Then
        say = say + 1
    End If
Next cll
Range("B2") = say

say = 0
For Each cll In rng
    If cll.Interior.Color = vbGreen Then
        say = say + 1
    End If
Next cll
Range("B3") = say

Range("G1:G" & Range("G65536").End(xlUp).Row).Resize(, 10).Clear

Set rng = Nothing

End Sub

 

[doors1]

teşekkür ederim eror verdi ama üzerinde ugrasabirim biraz.

 

[mancubus]

rica ederim.

ben aşağıdaki koşullarda test ettim. problem olmadı.

xl2003
D1'deki rakam = 21.840
Toplam bölme işlemi sayısı = 65.520