Скрытие строк в Excel 2013

Таким образом, я пытаюсь скрыть строки в Excel 2013 с помощью VBA на основе нескольких различных условий:




  • Если заголовок раздела "неиспользуемый", скрыть раздел. Каждый раздел-это именованный диапазон, чтобы сделать это проще.

  • если строка является частью именованного диапазона "Cblank", спрячьте ее.

    • Теперь самое сложное - для каждой ячейки в диапазоне ("CNonTest"), если C. Value = "" и C. Columns(41).Value = "" затем спрячьте их.

Диапазон ("CNonTest") находится в Col C дополнительная колонка, которая должна быть проверена Кол АК.



Для дополнительной сложности мне нужно, чтобы этот макрос запускался каждый раз, когда изменяется любой 1 из 8 различных полей проверки.



Ниже приведен код, который я в настоящее время имею: 



    Sub CompHide()



    With Sheets("Comparison").Cells

       .EntireRow.Hidden = False



    If Range("C9").Value = "Unused" Then

        Range("CMarket1").EntireRow.Hidden = True

    End If



    If Range("C115").Value = "Unused" Then

        Range("CMarket2").EntireRow.Hidden = True

    End If



    If Range("C221").Value = "Unused" Then

        Range("CMarket3").EntireRow.Hidden = True

    End If



    If Range("C329").Value = "Unused" Then

        Range("CMarket4").EntireRow.Hidden = True

    End If



    If Range("C437").Value = "Unused" Then

        Range("CMarket5").EntireRow.Hidden = True

    End If



    If Range("C545").Value = "Unused" Then

        Range("CMarket6").EntireRow.Hidden = True

    End If



    If Range("C653").Value = "Unused" Then

        Range("CMarket7").EntireRow.Hidden = True

    End If



    If Range("C761").Value = "Unused" Then

        Range("CMarket8").EntireRow.Hidden = True

    End If



    If Range("C869").Value = "Unused" Then

        Range("CMarket9").EntireRow.Hidden = True

    End If



    If Range("C977").Value = "Unused" Then

        Range("CMarket10").EntireRow.Hidden = True

    End If



    For Each C In Range("CNonTest")

        If C.Value = "" And C.Columns(41).Value = "" Then

            C.EntireRow.Hidden = True

        End If

    Next







    Range("CBlank").EntireRow.Hidden = True



    End With

End Sub


Тогда на листе у меня есть такой код: 



    Private Sub Worksheet_Change(ByVal Target As Range)



If Intersect(Target, Me.Range("A4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("D4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("G4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("K4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("AO4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("AR4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("AU4")) Is Nothing _

    Or _

    Intersect(Target, Me.Range("AY4")) Is Nothing _

    Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True





End Sub


Для кода листа я также пытался сделать это безрезультатно 



Private Sub Worksheet_Change(ByVal Target As Range)



If Intersect(Target, Me.Range("A4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("D4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("G4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("K4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("AO4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("AR4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True







If Intersect(Target, Me.Range("AU4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True





If Intersect(Target, Me.Range("AY4")) Is Nothing Then Exit Sub



    Application.EnableEvents = False 'to prevent endless loop

    Application.ScreenUpdating = False



    Call CompHide



    Application.ScreenUpdating = True

    Application.EnableEvents = True





End Sub


Этот код, кажется, все работает нормально, и когда я шагаю через CompHide, используя F8, он работает отлично. Поэтому я думаю, что проблема заключается в коде на самом листе. Вы увидите комментарий в том коде, который упоминает, чтобы предотвратить бесконечный цикл, этот комментарий пришел из какого-то кода hand me down, не совсем уверенного, для чего он нужен, Но полагающего, что на основе комментария я его оставлю.



Когда я изменяю окно проверки, оно больше не скрывает все правильные вещи, только некоторые из них. К счастью, я не видел, чтобы он скрывал что-то, чего еще не предполагал. Я больше не говорю, потому что сначала этот код смотрел только на первое поле проверки, но теперь он смотрит на все 8.

601   2  

2 ответов:

Некоторые настройки обработчика событий: 

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range

    On Error GoTo haveError

    Set rng = Application.Intersect(Target, Me.Range("A4,D4,G4,K4,AO4,AR4,AU4,AY4"))

    If Not rng Is Nothing Then
        Application.EnableEvents = False 'to prevent endless loop
        Application.ScreenUpdating = False
        CompHide
        Application.EnableEvents = True
    End If
    Exit Sub

haveError:
    'always re-enable events
    '  (screenupdating setting is not persistent)...
    Application.EnableEvents = True

End Sub

И другая часть: 

Sub CompHide()

    Dim sht As Worksheet, C As Range

    Set sht = Sheets("Comparison")
    sht.Rows.Hidden = False

    SetRowVis "C9", "CMarket1"
    SetRowVis "C115", "CMarket2"
    '...and the rest

    For Each C In sht.Range("CNonTest")
        If C.Value = "" And C.EntireRow.Columns(43).Value = "" Then
            C.EntireRow.Hidden = True
        End If
    Next

    sht.Range("CBlank").EntireRow.Hidden = True
End Sub

'utility sub...
Sub SetRowVis(addr As String, rngName As String)
    With Sheets("Comparison")
        If .Range(addr).Value = "Unused" Then
            .Range(rngName).EntireRow.Hidden = True
        End If
    End With
End Sub
4  
2016-07-28 18:00:31

1-й, у вас есть проблема со ссылками на ваш CompHide Sub.
Вам нужно полностью ссылаться на все вызовы объектов Range на листе.

With Sheets("Comparison")
    .Cells.EntireRow.Hidden = False
    'Notice the dot in front of the Range object
    If .Range("C9").Value = "Unused" Then .Range("CMarket1").EntireRow.Hidden = True
    'Also notice that I used a one liner IF which I think is applicable for you
    'Rest of your code go here
    '.
    '.
    '.

End With
2-й, взгляни на пост Тима. Он меня опередил. :)
1  
2016-07-28 02:11:43

Comments

    Ничего не найдено.
Click here to cancel reply.