Hücredeki Sayıya Göre Veri Almak

[quantum_aso]

Merhaba;
Ekteki dosyamda a ve d sütunları arasında, satır sayısı her örneğimde değişecek verilerim olsun. veri bloğumda, d sütununda 1 olanları, j-m sütunları arasına dizmek istiyorum, tabi otomatik olarak. a-d sütunları arasındaki veriler, başka programdan kopyala yapıştır yapıyorum ve yapıştırdığım an j sütunundan itibaren, veri bölümündeki d sütununda 1 olanlar ayıklansın istiyorum. Umarım anlatabilmişimdir. Yardımlarınız için teşekkürler.

 

[Ömer]

Merhaba,

O1 hücresini yardımcı hücre olarak düşünerek,

=EĞERSAY(D:D;1)

formülü O1 hücresine yazın.

Daha sonra aşağıdaki formülü J1 hücresine yazarak;

=EĞER(SATIRSAY(J$1:J1)>$O$1;"";İNDİS(A$1:A$500;KÜÇÜK(EĞER($D$1:$D$500=1;
SATIR($A$1:$A$500)-SATIR($A$1)+1);SATIRSAY(J$1:J1))))

formülü dizi formülüne çevirin.

Bunun için;

Formülü hücreye yazdıktan sonra entera basmadan ctrl shift enter tuş kombinasyonu ile girişini tamamlayınız. Bu işlemden sonra formülün başına ve sonuna { } ayıraçları otomatik eklenecektir.

Bu işlemden sonra formülü yana ve alt hücrelere kopyalarsınız..

.

 

[quantum_aso]

cevabınız için çok teşekkür ederim tam istediğim gibi oldu
fakat ben ufak bir yanlışlık yapmışım soruyu sorarken. veri aralığım a-m sütunları arasında olması lazım. sizin verdiğiniz yardımcı hücre o, bende n sütununda. istediğim sıralamada q7 hücresinden başlayacak şekilde olmalı. verdiğiniz formülü bu şekle uyduramadım. yardımcı olursanız sevinirim

 

[Ömer]

Açıklamanızı destekleyen yeni bir dosya eklermisiniz..

.

 

[quantum_aso]

ilgili dosyayı ekledim
verilerim a ile m arasındaki sütunlarda mevcut. sizin yardımcı hücreniz bu dosyada n2 hücresinde. m sütunundaki 1 olan verileri "alınan veri" bölümündeki q7 hücresinden itibaren yazdırmak istiyorum. veri sayım çok yüksek olacak. 200000 den fazla verim olabilir.
ilk verdiğiniz formülü bu veri şablonuna göre düzenlerseniz çok sevinirim.

 

[İhsan Tank]

ilgili dosyayı ekledim
verilerim a ile m arasındaki sütunlarda mevcut. sizin yardımcı hücreniz bu dosyada n2 hücresinde. m sütunundaki 1 olan verileri "alınan veri" bölümündeki q7 hücresinden itibaren yazdırmak istiyorum. veri sayım çok yüksek olacak. 200000 den fazla verim olabilir.
ilk verdiğiniz formülü bu veri şablonuna göre düzenlerseniz çok sevinirim.

eki inceleyiniz
Önemli not : 200.000 veriden bahsediyorsunuz bu dosya çok fazla kasılabilir bilginiz olsun.
ben formülü 1000 satır baz alarak yaptım

 

[quantum_aso]

@İhsan Tank çok teşekkür ederim
Benim örneğim için 1000 yaptığınız sayıları 200.000 olarak değiştirmem sanırım yeterli olacak değilmi?

 

[İhsan Tank]

@İhsan Tank çok teşekkür ederim
Benim örneğim için 1000 yaptığınız sayıları 200.000 olarak değiştirmem sanırım yeterli olacak değilmi?

evet tüm formülleri değiştirmeniz yeterli üstteki mesajımda bir konudan bahsettim atlamazsanız sevinirim.
birde değiştirmek için size bir kısa yol söyliyeyim.
Q7 ile AC16 aralığını seçin ctrl+h yapın aranan değere 1000 yeni değere 200000 yazınız ve tümü değiştiri seçiniz.
ve N2 hücresindeki yardımcı hücrede yazan numraya göre
Q16 ile AC16 aralığındaki formülleri aşağıya doğru yayınız.

 

[Ömer]

ilgili dosyayı ekledim
verilerim a ile m arasındaki sütunlarda mevcut. sizin yardımcı hücreniz bu dosyada n2 hücresinde. m sütunundaki 1 olan verileri "alınan veri" bölümündeki q7 hücresinden itibaren yazdırmak istiyorum. veri sayım çok yüksek olacak. 200000 den fazla verim olabilir.
ilk verdiğiniz formülü bu veri şablonuna göre düzenlerseniz çok sevinirim.

Eğer veri sayınızın 200.000 olma durumu varsa formülle çalışmanızı tavsiye etmem.

Aşağıdaki kodları module kopyalın ve butona bağlayarak çalıştırınız..

Sub BirOlanlarıBul()
 
Dim c As Range, sat As Long, son As Long, ilkadres As Variant
 
Application.ScreenUpdating = False
son = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q7:AC" & son).ClearContents
 
sat = 6
With Range("M1:M" & son)
    Set c = .Find(1, LookIn:=xlValues)
    If Not c Is Nothing Then
        ilkadres = c.Address
        Do
            sat = sat + 1
            Range("A" & c.Row & ":M" & c.Row).Copy
            Range("Q" & sat).PasteSpecial xlPasteValues
            Application.CutCopyMode = False: [Q6].Select
 
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
End With
 
Application.ScreenUpdating = False
End Sub

 

[quantum_aso]

çok teşekkür ederim
verilerimi tamamlayıp iki farklı formül-butonuda deneyeceğim sonucu en kısa zamanda bildiririm. tekrar çok teşekkürler