isme göre satır Gizleme..

[izomer]

Değerli Excel Web Ailesine Selamlar.

2 Sayfam var 1. ci sayfada (Anasayfa) adını gizlediğim birinin diğer sayfadada (sayfa2) mevcut ise otomatikman satırın renginin değişerek (örneğin turuncu) gizlenmesini istiyorum ama beceremedim..yardımcı olursanız çok sevinirim..Örnek Ektedir..

Saygılarımla..

 

[Ömer]

Merhaba,

Sayfa2 nin kod bölümüne kopyalayın. Yalnız sizin açıklamanızdan satırı tamamen gizlemeyi anladım ve ona göre yazdım. Örnek dosyada ise gizlemek yerine aralığı daraltmışsınız.

Private Sub Worksheet_Activate()

    Dim Sa As Worksheet, i As Long, c As Range, Adr As String

    Set Sa = Sheets("Anasayfa")
    
    Rows("2:" & Rows.Count).Interior.ColorIndex = 0

    For i = 2 To Sa.Cells(Rows.Count, "B").End(xlUp).Row
        If Sa.Cells(i, "B").EntireRow.Hidden = True Then
            With Range("C:C")
                Set c = .Find(Sa.Cells(i, "B"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        Rows(i).Interior.ColorIndex = 45
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
        End If
    Next i

End Sub

.

 

[izomer]

hocam sayfa 2 nin renk değişiyor ancak gizlemesini yapmıyor şu an..

 

[Ömer]

Bu şekilde deneyin.

Private Sub Worksheet_Activate()

    Dim Sa As Worksheet, i As Long, j As Long

    Set Sa = Sheets("Anasayfa")
    
    Application.ScreenUpdating = False
    Rows("2:" & Rows.Count).Interior.ColorIndex = 0

    For i = 2 To Sa.Cells(Rows.Count, "B").End(xlUp).Row
        If Sa.Cells(i, "B").EntireRow.Hidden = True Then
            For j = 2 To Cells(Rows.Count, "C").End(xlUp).Row
                If Sa.Cells(i, "B") = Cells(i, "C") Then
                    Rows(i).Interior.ColorIndex = 45
                    Rows(i).EntireRow.Hidden = True
                End If
            Next j
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

.

 

[izomer]

ilaç Gibi Geldi hocam Allah Razı olsun..Saat gibi çalışıyor..

 

[Ömer]

Rica ederim.

Gizleme ilave olduğu için aşağıdaki göster satırını atlamışım.

Rows("2:" & Rows.Count).Interior.ColorIndex = 0

satırından hemen sonra aşağıdaki satırı ilave edersiniz.

Rows("2:" & Rows.Count).EntireRow.Hidden = False

.

 

[izomer]

Aynı isimlerin satırını gizleme

Hocam yalnız ad soyad yazan yerlere karışık isim soyad koyduğumda malesef çalışmıyor..
ekteki örnekteki gibi..

 

[Ömer]

Bu şekilde deneyin. Yazım hatası ve gizlemeden kaynaklanan bir sorun vardı.

Private Sub Worksheet_Activate()

    Dim Sa As Worksheet, i As Long, j As Long

    Set Sa = Sheets("Anasayfa")
    
    Application.ScreenUpdating = False
    Rows("2:" & Rows.Count).Interior.ColorIndex = 0
    Rows("2:" & Rows.Count).EntireRow.Hidden = False
    For i = 2 To Sa.[B:B].Find("*", , , , xlByRows, xlPrevious).Row
        If Sa.Cells(i, "B").EntireRow.Hidden = True Then
            For j = 2 To [C:C].Find("*", , , , xlByRows, xlPrevious).Row
                If Sa.Cells(i, "B") = Cells(j, "C") Then
                    Rows(j).Interior.ColorIndex = 45
                    Rows(j).EntireRow.Hidden = True
                End If
            Next j
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

.

 

[izomer]

Hocam Elinize sağlık kendi projemdede çalışıyor (ekteki dosyada) ama işçiler Şubat sayfasına geçerken hata veriyor ve end dediğimde işlemi gerçekleştiriyor .. işçi listesinde 61. satırı gizledim ve görmek için işçi şubat sayfasına geçince debug veriyor. sebebini çözemedim gitti..ama burdaki örnek dosyada çalışıyor onda sıkıntı yok..ektekinde 62. satırı gizledim diğer sayfaya geçince orda hata veriyor..

Saygılarımla..

 

[Ömer]

Formül sonucundaki #YOK hatalı hücrelerden dolayı oluyor.

C sütunundaki formülü aşağıdaki gibi değiştirin.

=[COLOR="Red"]EĞERHATA([/COLOR]DÜŞEYARA(İŞÇİ_LİSTESİ!B3;İŞÇİ_LİSTESİ!B3:D3001;1;0)[COLOR="red"];"")[/COLOR]

.

 

[izomer]

şimdi anladım sayın hocam sağlıcakla kalın..Excel Web Ailesine saygılarımla..