Soru Filtrelenmiş Veriye Makro Uygulamak

[tuvons]

Arkadaşlar merhaba,

Filtrelediğim veriler için aşağıdaki kodu uyguladığımda filtreye dahil olmayan satırlarda da işlem yapıyor. Benim istediğim kaç satırda işlem yapılması gerektiğini yazdığımda sadece görünür hücrelerden o kadar satırda işlem yapsın. Bu kodları nasıl değiştirebilirim?

Teşekkürler.

Private Sub CommandButton1_Click()
sutun1 = sutun1
satir1 = satir1
eklemetutari1 = eklemetutari1
Dim deneme1 As Integer
Cells(sutun1 & ",1").Select
ActiveCell.Offset(1, 0).Select
For deneme1 = 1 To satir1
ActiveCell.Value = ActiveCell.Value + eklemetutari1
ActiveCell.Offset(1, 0).Select
Next deneme1

Dim txt As Control
    For Each txt In Me.Controls
    If TypeName(txt) = "TextBox" Then txt.Value = ""
    Next
    
End Sub

 

[Korhan Ayhan]

Merhaba,

Filtre ile gizlenmiş satırın satır yüksekliği sıfır olur. Kodlarınızda bundan faydalanabilirsiniz.

 

[Ömer]

Merhaba,

Bir örnek, A sütununda filtrelenmiş alanda işlem yapar. Kendinize göre uyarlayabilirsiniz.

Sub F_Alan()
    
    Dim son As Long, i As Range
    
    son = Cells(Rows.Count, "A").End(xlUp).Row
    
    For Each i In Range("A1:A" & son).SpecialCells(xlCellTypeVisible)
        MsgBox i
    Next i
    
End Sub

 

[tuvons]

Merhaba,

Filtre ile gizlenmiş satırın satır yüksekliği sıfır olur. Kodlarınızda bundan faydalanabilirsiniz.

Sayın @Korhan Ayhan bahsettiğiniz işlemi nasıl yapabilirim? Aradım ama işime yarayacak bilgiye ulaşamadım.

 

[Korhan Ayhan]

Şöyle olabilir;

For deneme1 = 1 To satir1
If ActiveCell.RowHeight <> 0 Then 
ActiveCell.Value = ActiveCell.Value + eklemetutari1
ActiveCell.Offset(1, 0).Select
End If
Next deneme1

 

[tuvons]

Şöyle olabilir;

For deneme1 = 1 To satir1
If ActiveCell.RowHeight <> 0 Then
ActiveCell.Value = ActiveCell.Value + eklemetutari1
ActiveCell.Offset(1, 0).Select
End If
Next deneme1

@Korhan Ayhan Bey aşağıdaki şekilde yaptım ama yine filtre koyunca hücrelere eklemek istediğim tutarları eklemiyor. Neden olabilir acaba?

Private Sub CommandButton1_Click()
sutun1 = sutun1
satir1 = satir1
eklemetutari1 = eklemetutari1
Dim deneme1 As Integer
Cells(sutun1 & ",1").Select
ActiveCell.Offset(1, 0).Select
For deneme1 = 1 To satir1
If ActiveCell.RowHeight > 0 Then
ActiveCell.Value = ActiveCell.Value + eklemetutari1
ActiveCell.Offset(1, 0).Select
End If
Next deneme1

Dim txt As Control
    For Each txt In Me.Controls
    If TypeName(txt) = "TextBox" Then txt.Value = ""
    Next
    
End Sub

 

[Korhan Ayhan]

Dosyanızı paylaşırsanız daha net sonuçlar alabilirsiniz.