• DİKKAT

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

döngüde sıkıntı?

L

lionheart

Katılım
24 Haziran 2011
Mesajlar
23
Excel Vers. ve Dili
Excel 2007-Türkçe
üstadlar merhaba.

ekte gönderdiğim dosyada bir tür filtreleme yaptırdığım bir makro var.
eminim bu yaptığım işin daha gelişmiş, daha etkin bir yolu vardır. ancak ben henüz öğrenme aşamasındayım.
bu yaptığım işlemde ilk j için hesaplama yapılıyor ancak sonraki j ler için yapılmıyor. hepsini sıfır veriyor. bunun neden böyle olduğunu öğrenmek benim için çok geliştirici bir adım olacak. yardımlarınızı bekliyorum. teşekkür ederim.
 
lionheart' Alıntı:
üstadlar merhaba.

ekte gönderdiğim dosyada bir tür filtreleme yaptırdığım bir makro var.
eminim bu yaptığım işin daha gelişmiş, daha etkin bir yolu vardır. ancak ben henüz öğrenme aşamasındayım.
bu yaptığım işlemde ilk j için hesaplama yapılıyor ancak sonraki j ler için yapılmıyor. hepsini sıfır veriyor. bunun neden böyle olduğunu öğrenmek benim için çok geliştirici bir adım olacak. yardımlarınızı bekliyorum. teşekkür ederim.
Genişletmek için tıkla ...

Dorununuz hakkında yardımcı olmak isterdim fakat sanırım dosyayı sisteme yüklemeyi unuttunuz.
 
üstadlar makrolu excel dosyasını göndermeme izin vermedi. o yüzden makroyu buraya kopyalıyorum:

son = Cells(1048576, "b").End(3).Row

Dim arr(1 To 16)

For j = 19 To 21


For k = 1 To 16
arr(k) = 0
Next k



For i = 1 To son




If Cells(i, j) = 1 Then


If Cells(i, 7) = 0 Then

arr(1) = arr(1) + 1



If Cells(i, 9) = 0 Then
arr(2) = arr(2) + 1
End If

If Cells(i, 11) = 0 Then
arr(3) = arr(3) + 1
End If

If Cells(i, 13) = 0 Then
arr(4) = arr(4) + 1
End If

End If







If Cells(i, 7) = 3 Then

arr(5) = arr(5) + 1

If Cells(i, 9) = 0 Then
arr(6) = arr(6) + 1
End If


If Cells(i, 11) = 0 Then
arr(7) = arr(7) + 1
End If

If Cells(i, 13) = 0 Then
arr(8) = arr(8) + 1
End If

End If





If Cells(i, 7) = 14 Then
arr(9) = arr(9) + 1

If Cells(i, 9) = 0 Then
arr(10) = arr(10) + 1
End If


If Cells(i, 11) = 0 Then
arr(11) = arr(11) + 1
End If

If Cells(i, 13) = 0 Then
arr(12) = arr(12) + 1
End If


End If






If Cells(i, 7) = 37 Then
arr(13) = arr(13) + 1

If Cells(i, 9) = 0 Then
arr(14) = arr(14) + 1
End If


If Cells(i, 11) = 0 Then
arr(15) = arr(15) + 1
End If

If Cells(i, 13) = 0 Then
arr(16) = arr(16) + 1
End If


End If






End If



Next i

s = 1



If j = 19 Then
Sheets.Add After:=Sheets(Sheets.Count)
End If




For n = 1 To 4

For m = 1 To 4
Sheets(Sheets.Count).Select


Cells(n + (5 * (j - 19)), m) = arr(s)
s = s + 1

Next m

Next n


Next j





End Sub



End Sub
 

Ekli dosyalar

üstad yapmak istediğim aslında bir nevi filtreleme ve saydırma işlemi.
il etapta 19. hücrede 1 değerini alan ve bu hücreye karşılık gelen 7. sütunda 0 değerini alan denekleri saydırıp arr(1) e atıyorum her seferinde.

daha sonra bu şartlar sabit kalmak kaydıyla 9. 11. ve 13. hücrelerde 0 değerleri alanları ayrı ayrı belirleyip sırasıyla arr(2), arr(3) ve arr(4) e atıyorum.

daha sonra yine 19. hücrede 1 e karşılık gelen ve 7. sütunda 3 değerini alan değerleri belirleyip arr(5) e atıyorum. sonrasında ise; bu şartlar altında 9. 11. ve 13. hücrelerde 0 değerlerini alan değerleri ayrı ayrı belirleyip sırasıyla arr(6) arr(7) ve arr(8) e atıyorum.

benzer şekilde 7. sütunda bu sefer 14 değerini, sonrasında ise 37 değerlerini seçip aynı işlemleri uyguluyorum. ve arr(16) ya kadar geliyorum. ve sonuçta yeni bir sayfada 4 satırı 4 sütunu olan bir matris elde ediyorum. makro ilk etapta bunu yapıyor, sıkıntı olmuyor. Ancak ne zaman ki aynı işlemleri 20. sütunda 1 değerini alan denekler için yapmak istersem bana 4 e 4 ama bütün değerleri 0 olan bir matris veriyor.

nerede hata yaptığımı çok merak ediyorum. tabi ki bu arada bu yaptığım işlemin daha etkin yollarını öğrenmek de isterim.
nerede hata yaptığımı öğrenmek benim için çok ilerletici bir adım olacak.

yardımlarınızı bekliyorum. iyi çalışmalar. şimdiden teşekkürler.
 
makro uzun görünebilir ancak çok basit işlemler yapıyor. sadece aynı işlemleri tekrar tekrar farklı kriterler için yaptığından satır sayısı fazla.
 
lionheart' Alıntı:
makro uzun görünebilir ancak çok basit işlemler yapıyor. sadece aynı işlemleri tekrar tekrar farklı kriterler için yaptığından satır sayısı fazla.
Genişletmek için tıkla ...

ekteki dosyada yapmak istediğinizi formulle yapmaya çalıştım eğer istediğiniz ekteki işlemse macro ile yamaya çalışırım kontrol edip donerseniz sevinirim.


İyi Çalışmalar
 

Ekli dosyalar

Evet hocam. yapmak istediğim tam da bu.
19. sütun için olan kısmı yani ilk 16 değeri hesaplıyor. j=20 olunca döngüde bir sıkıntı oluyor ve diğer bütün 16'lık değerleri 0 veriyor. döngüde bakıyorum bakıyorum bir hata göremedim. bu arada topla.çarpım formülünü öğrendim sayende. Allah razı olsun. işte bir de bunun makrosunu yazabilirsem çok iyi olacak. döngüde nerede hata yaptığımı da çok merak ediyorum. yardımların için sağol hocam, eyvallah.
 
lionheart' Alıntı:
üstad?.....
Genişletmek için tıkla ...

Ekteki kodları denermisin sanırım oldu.

Kod: 
Sub dddd()

Dim Say(1 To 4)
Say(1) = 0
Say(2) = 3
Say(3) = 14
Say(4) = 37
hk = 1
satır = 1
hk2 = 1
Sheets("Sayfa1").Select

Dim arr(1 To 16)

For b = 19 To 21

For k = 1 To 16
arr(k) = 0
Next k

bas:
For a = 2 To Cells(1048576, b).End(3).Row

If Cells(a, b).Value = 1 And Cells(a, 7).Value = Say(hk) Then
arr(hk2) = arr(hk2) + 1
Satr = 1
Else
Satr = 0
End If
If Satr = 1 And Cells(a, 9).Value = 0 Then arr(hk2 + 1) = arr(hk2 + 1) + 1
If Satr = 1 And Cells(a, 11).Value = 0 Then arr(hk2 + 2) = arr(hk2 + 2) + 1
If Satr = 1 And Cells(a, 13).Value = 0 Then arr(hk2 + 3) = arr(hk2 + 3) + 1
Next a


Sheets("Sayfa2").Select

For s = 1 To 4
Cells(satır, s).Value = arr(hk2 + s - 1)
Next s
Sheets("Sayfa1").Select

If hk = 4 Then
GoTo Adım2:
Else
hk = hk + 1
hk2 = hk2 + 4
satır = satır + 1
GoTo bas:
End If

Adım2:
hk = 1
hk2 = 1
satır = satır + 2
Next b
End Sub
 
üstad eline, emeğine sağlık. çok güzel olmuş. denedim, sorunsuz çalışıyor.
başka bir makro yazarken de kullanabileceğim çok güzel uygulamalar öğrendim sayende, özellikle döngü konusunda, sağolasın.
benim yazdığım makrodaki sıkıntı gözüne çarptı mı üstad?

benim makro amatörce olduğu için satır sayısı çok. öyle çok teknik, pratik uygulamalar yok. bi bakabilir misin hocam sorun nerede?
 
hocam sorunu buldum. yeni safya açtırıp, bu sayfaya verileri girdikten sonra, tekrar sayfa 1 e dönmeyi unutmuşum.
tekrar sağolasın hocam. iyi çalışmalar.
 
lionheart' Alıntı:
hocam sorunu buldum. yeni safya açtırıp, bu sayfaya verileri girdikten sonra, tekrar sayfa 1 e dönmeyi unutmuşum.
tekrar sağolasın hocam. iyi çalışmalar.
Genişletmek için tıkla ...

Teşekkürler Kolay Gelsin dongu kodlarını okumak kadar kotu birşey yok zaman sorunu nedeni ile daha bakamamıştım sevindim bulduğunuza.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst