• DİKKAT

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

Bulunduğum satır renkli+boş satırları gizle

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,181
Excel Vers. ve Dili
Ofis 2019 Türkçe
Ekli örnek dosyamda yedek parça stoku tutmaktayım, sayfanın kod bölümündeki kodları silmeden bulunduğumuz satırın renklendirilmesi ile F sutununda stokta kalmayan (boş olan) satırların gizlenmesini istiyorum.
Not: F sutununda formüller bulunmaktadır.
Bu konuda yardımcı olabilecek arkadaşlarıma şimdiden çok teşekkür ediyorum. Saygılar.
 

Ekli dosyalar

Renk için bir çözüm buldum

Arkadaşlar uzun bir uğraştan sonra bulunduğun satırın renklendirmesi için bir çözüm buldum, F sutunundaki boş satır gizlemesi için yardımlarınızı bekleyeceğim.
 

Ekli dosyalar

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Unprotect Password:=""
    On Error Resume Next
    If Application.CutCopyMode = xlCopy Then Exit Sub
    If Application.CutCopyMode = xlCut Then Exit Sub
    Call RenkSil
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 18)).FormatConditions.Add Type:=xlExpression, Formula1:=1
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 18)).FormatConditions(1).Interior.ColorIndex = 36
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 18)).FormatConditions(1).Font.Bold = True
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 18)).FormatConditions(1).Font.ColorIndex = 3
    
    ActiveCell.FormatConditions.Add Type:=xlExpression, Formula1:=1
    ActiveCell.FormatConditions(1).Interior.ColorIndex = 15
    
    If Intersect(Target, [A:A]) Is Nothing Then GoTo Son
    If Target.Address = "$a$1" Then Exit Sub
[COLOR=red]    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False
    For Satır = 2 To [A65536].End(3).Row
    If Cells(Satır, "F").Value = 0 Then
    Rows(Satır).EntireRow.Hidden = True
    End If
    Next
    Application.ScreenUpdating = True
[/COLOR]    If Target.Offset(0, 0).Value & ".JPG" <> "" Then
    If UCase(Right(Target.Offset(0, 0).Value & ".JPG", 3)) = "JPG" Or UCase(Right(Target.Offset(0, -1).Value & ".BMP", 3)) = "BMP" Then
    Image1.Top = Target.Offset(0 + 1, 1).Top
    Image1.Left = Target.Offset(0 + 1, 1).Left
    If Not Image1.Visible Then Image1.Visible = True
    If Dir(Cells(1, 19) & Target.Offset(0, 0).Value & ".JPG") <> "" Then
    Image1.Picture = LoadPicture(Cells(1, 19) & Target.Offset(0, 0).Value & ".JPG")
    Image1.AutoSize = True
    Else
    Image1.Picture = Empty
    Image1.Visible = False
    Image1.Picture = Nothing
    End If
    Else
    GoTo Son
    End If
    End If
    Exit Sub
Son:
    Image1.Visible = False
    Image1.Picture = Nothing
    ActiveSheet.Protect Password:=""
End Sub
 
Sayın Korhan Ayhan hocam, size ne kadar teşekkür etsem azdır, tam istediğim gibi olmuş, test edip denedim mükemmel çalışıyor, gizlenen satırlardan stok girişi yapıldığında tekrar görünür hale geçiyor, kısacası harika olmuş, elinize sağlık. Saygılar. Tahsin
 
Birinci mesajımdaki dosyada, seçili satırın ekranın en üstünde yani başlık bilgilerinin hemen altında yer almasını nasıl sağlayabiliriz. Gelen resimlerin sağlıklı görünmesi açısından. Teşekkürler.
 
5. Mesajımda istediğimin olumlu olma ihtimalı varmıdır acep.
 
Selamlar,

Birinci mesajınızdaki dosyanızdaki kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.CutCopyMode = xlCopy Then Exit Sub
    If Application.CutCopyMode = xlCut Then Exit Sub
    On Error Resume Next
    If Intersect(Target, [A:A]) Is Nothing Then GoTo Son
    If Target.Address = "$a$1" Then Exit Sub
    
[COLOR=red]    Üst_Satır = ActiveWindow.ActivePane.ScrollRow
    Aktif_Satır = Target.Row
    Satır_Say = Windows(1).VisibleRange.Rows.Count
    If Üst_Satır <= Aktif_Satır Then
    ActiveWindow.SmallScroll Down:=Aktif_Satır - Üst_Satır
    End If
[/COLOR]    
    If Target.Offset(0, 0).Value & ".JPG" <> "" Then
    If UCase(Right(Target.Offset(0, 0).Value & ".JPG", 3)) = "JPG" Or UCase(Right(Target.Offset(0, -1).Value & ".BMP", 3)) = "BMP" Then
    Image1.Top = Target.Offset(0 + 1, 1).Top
    Image1.Left = Target.Offset(0 + 1, 1).Left
    If Not Image1.Visible Then Image1.Visible = True
    If Dir(Cells(1, 19) & Target.Offset(0, 0).Value & ".JPG") <> "" Then
    Image1.Picture = LoadPicture(Cells(1, 19) & Target.Offset(0, 0).Value & ".JPG")
    Image1.AutoSize = True
    Else
    Image1.Picture = Empty
    Image1.Visible = False
    Image1.Picture = Nothing
    End If
    Else
    GoTo Son
    End If
    End If
    Exit Sub
Son:
    Image1.Visible = False
    Image1.Picture = Nothing
End Sub
 
Sn. korhan ayhan hocam, soruyu yazarken cevabın geleceğini hiç tahmin etmiyordum, gerçekten bu harika birşey, demekki excel de düşünebildiğin herşeyi yapabilmek mümkün olabiliyor, cevbı var ise bunun sizden geleceğini biliyordum, gerçekten mükemmelsiniz, çok teşekkür ediyorum. Saygılar Tahsin.
 
merhabalar, ekteki dosyayı inceledim gerçekten harika işler başarmışsınız. boş hücrelerin gizlenmesi ile ilgili bir koda ihtiyacım var. ancak hücreler verileri başka bir sayfadan alıyor, hücreye diğer sayfadan veri geldikçe gizlenmiş hücrelerin açılması gerekiyor. iyi çalışmalar... yardımlarınız için şimdiden teşekkür ederim...
 
Selamlar,

Ekteki örnek dosyayı incelermisiniz. Sayfa2 aktif olunca kodlar çalışır. A sütununda formül sonucu boş olan hücrelere ait satırlar gizlenir.
 

Ekli dosyalar

selam
bende bu kodu kullanmak istiyorum ama olmuyor.
hata sub or fuction not defined hatası veriyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst