Soru Sutundaki sayıların hücre adreslerini listeleme

[assenucler]

Değerli Dostlar,


AB sütunu (2:1800) aralığındaki satırlarda, 0 ve 1 sayıları bulunmaktadır.

İstediğim:
1 yazılı sayıların bulunduğu hücre adreslerinin, AD Sütunu 2 nci satırdan itibaren alt alta listelenmesidir.

Yardımız için önceden teşekkürler.

Saygılarımla,
Selim

 

[Orion1]

Buyurun.

Sub bir()
Dim i As Integer, sonsat As Long, sat As Long
Range("AD2:AD" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "AB").End(xlUp).Row
sat = 2
For i = 2 To sonsat
    If Cells(i, "AB").Value = 1 Then
        Cells(sat, "AD").Value = Range("AB" & i).Address
        sat = sat + 1
    End If
Next i
MsgBox "bitti"

End Sub

 

[Muzaffer Ali]

Alternatif

Sub test()
    Range("AD2:AD2000").Formula = "=IF(AB2=1,Address(Row(AB2),Column(AB2)),"""")"
    Range("AD2:AD2000").Copy
    Range("AD2:AD2000").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Dolar "$" işareti olmasın isterseniz

Sub test()
    Range("AD2:AD2000").Formula = "=SUBSTITUTE(IF(AB2=1,Address(Row(AB2),Column(AB2)),""""),""$"","""")"
    Range("AD2:AD2000").Copy
    Range("AD2:AD2000").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

[/CODE]

 

[Haluk]

Alternatif olarak formülle çözüm, ekli dosyadadır....

AD2 hücresindeki dizi formülü;

=IFERROR("AB"&SMALL(IF($AB$2:$AB$1800=1;ROW($AB$2:$AB$1800));ROW(1:1));"")

.

 

[assenucler]

Sayın Orion1,
Sayın Muzaffer Ali,
Sayın Haluk,

Hepinize ilginiz ve katkılarınız için ayrı ayrı teşekkürler.
Allah'ım sizlerden razı olsun.

Saygılarımla,
Selim