Filtreleme yapınca ilk satırı yazdırmak

[gkhn2]

Merhaba,

Ekteki dosyada B2 hücresine filtrelenen ilk hücrenin içeriği gelsin istiyorum.

Mümkün müdür?





http://dosya.co/5tar3i5ec2gf/FİLTRE_YAPILINCA_İLK_SATIRI_YAZDIRMAK.xlsx.html

 

[FERAZ]

Sub xxx()
Dim xx As Range, sonn As Long
sonn = Range("A" & Rows.Count).End(3).Row

For Each xyz In Range("A10:A" & sonn).SpecialCells(xlCellTypeVisible)
If Not IsEmpty(xyz) Then
Range("B2").Value = xyz
Exit Sub
End If
Next

End Sub

 

[FERAZ]

Aceleden If ActiveSheet.FilterMode = True Then kısmını eklemeyi nutmuşum koda eklemeyi.

Sub xxx()

Dim xx As Range, sonn As Long
sonn = Range("A" & Rows.Count).End(3).Row
If ActiveSheet.FilterMode = True Then
For Each xyz In Range("A10:A" & sonn).SpecialCells(xlCellTypeVisible)
     If Not IsEmpty(xyz) Then
     Range("B2").Value = xyz
     Exit Sub
     End If
Next
End If

End Sub

 

[Korhan Ayhan]

Alternatif;

Linki inceleyiniz.

http://www.excel.web.tr/f47/filtre-ile-secilen-hucredeki-metini-ba-ka-hucreye-t143746.html

 

[FERAZ]

Buda KTF ile.

http://www.dosyaupload.com/4Fve

Fonksiyon yazılımı

=bulll(A10:A265536)

Function bulll(Hucre As Range)
Application.Volatile
Dim hcr As Variant

For Each hcr In Hucre
    If hcr.EntireRow.Hidden = False Then
            bulll = hcr
            Exit For
    End If
Next

End Function

 

[gkhn2]

Alternatif;

Linki inceleyiniz.

http://www.excel.web.tr/f47/filtre-ile-secilen-hucredeki-metini-ba-ka-hucreye-t143746.html

http://dosya.co/mf9ol0ycq5b0/indis_FİLTRE_YAPILINCA_İLK_SATIRI_YAZDIRMAK.xlsx.html

indis ile yapmaya çalıştım fakat bir yerde yanlış yaptım sanırım

 

[gkhn2]

Aceleden If ActiveSheet.FilterMode = True Then kısmını eklemeyi nutmuşum koda eklemeyi.

Sub xxx()

Dim xx As Range, sonn As Long
sonn = Range("A" & Rows.Count).End(3).Row
If ActiveSheet.FilterMode = True Then
For Each xyz In Range("A10:A" & sonn).SpecialCells(xlCellTypeVisible)
     If Not IsEmpty(xyz) Then
     Range("B2").Value = xyz
     Exit Sub
     End If
Next
End If

End Sub

teşekkür ederim. bu yazdığınız güncellemiyor sürekli. ama ktf olan daha iyi gibi.

 

[FERAZ]

Rica ederiz.
Sub olan güncellenmez.
Aslında bir yolu var fakat sayfada formül olması gerek güncelleme için.

 

[FERAZ]

http://www.dosyaupload.com/4Fwr

J1 e =ALTTOPLAM(103;A10:A65536)-BAĞ_DEĞ_DOLU_SAY(A10:A65536)
formülü eklenip(Tabii formül başka hücreyede eklenebilir)
Formül aynı sayfada olmalı.

Sayfa kodunada alttaki kod eklenirse otomatikleşir.
Banada birisi yardım etmişti.
Faydası olsun insanlara.

Private Sub Worksheet_Calculate()
If Range("J1").Value < 0 Then xxx
If Range("J1").Value = 0 Then Range("B2").Value = Range("A10").Value
End Sub

Sub xxx()

Dim xx As Range, sonn As Long
sonn = Range("A" & Rows.Count).End(3).Row
If ActiveSheet.FilterMode = True Then
For Each xyz In Range("A10:A" & sonn).SpecialCells(xlCellTypeVisible)
     If Not IsEmpty(xyz) Then
     Range("B2").Value = xyz
     Exit Sub
     End If
Next
End If

End Sub

 

[Korhan Ayhan]

Dizi formül olarak uygulayın.