VBA 하나의 하위에서 작동하는 루프 초기화의 경우 거의 동일한 하위가 작동하지 않음

Question

VBA에서 열 머리글을 순환하려고합니다 (이동 될 수 있음). 머리글 이름을 찾아 해당 열을 숨겨서 반복합니다. 숨기기 부분이 제대로 작동하지만 간단한 '숨기기 해제'를 수행하기로 결정하고 오류가 발생했습니다. 런타임 오류 '92': 루프가 초기화되지 않았습니다.

내가 변경 한 유일한 사항은 현재 선택 항목을 숨기거나 숨기지 않는지 여부입니다 (참 또는 거짓). 변수 이름을 변경하려고했는데 어쩌면 무언가가 잠수정 사이에서 그들을 공유함으로써 무언가를 망칠 수 있다고 생각했지만 도움이되지 못했습니다.

작업 '숨기기'서브 코드는 다음과 같습니다 :

Public Sub Activate_Print_Mode() 

Dim SearchArray() As Variant SearchArray = Array("ISBN", "Sub Title", 
"Paper Cut Off", "Despatch Date (ExW)", "Printer Location", "UK WH 
ETA", "Suggested Pub ExW", "Suggested Pub ExUK", "INDENT/STATUS", 
"UK VAT Price", "FX", "GB Net Price", "AU Price + Freight", "S/A", 
"Discount", "PRICE NOTES", "ORDERED", "Budget Value", "Misc Specs") 

Dim element As Variant 

For Each element In SearchArray 
    ' perform search, hide column 
    'counter = counter + 1 
    Rows("3:3").Select 
    Selection.Find(What:=element, After:=ActiveCell, LookIn:=xlFormulas, _ 
     LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
     MatchCase:=True, SearchFormat:=False).Activate 
    ActiveCell.Offset(-1, 0).Select 


    Selection.EntireColumn.Hidden = True 


    Next element 
     ActiveSheet.Range("A1").Select 

End Sub 

비 작업 '쇼'서브는 다음과 같습니다 :

는

Public Sub DeActivate_Print_Mode() 

Dim DispSearchArray() As Variant SearchArray = Array("ISBN", "Sub 
Title", "Paper Cut Off", "Despatch Date (ExW)", "Printer Location", 
"UK WH ETA", "Suggested Pub ExW", "Suggested Pub ExUK", "INDENT/
STATUS", "UK VAT Price", "FX", "GB Net Price", "AU Price + Freight", 
"S/A", "Discount", "PRICE NOTES", "ORDERED", "Budget Value", "Misc 
Specs") 

Dim DispElement As Variant 


For Each DispElement In DispSearchArray 
    ' perform search, hide column 
    'counter = counter + 1 
    Rows("3:3").Select 
    Selection.Find(What:=element, After:=ActiveCell, LookIn:=xlFormulas, _ 
     LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
     MatchCase:=True, SearchFormat:=False).Activate 
    ActiveCell.Offset(-1, 0).Select 
    Selection.EntireColumn.Hidden = False 

    Next DispElement 
     ActiveSheet.Range("A1").Select 

End Sub 

무슨 준다?

Answer 1

Find() 숨겨진 열/행

에 값을 찾지 못하는

내가 머리글 행에 대한 매개 변수를 추가하여

Sub hidethem() 
    Set_Print_Mode True 
End Sub 
Sub showthem() 
    Set_Print_Mode False 
End Sub 

Public Sub Set_Print_Mode(doHide As Boolean) 

    Dim SearchArray As Variant 
    Dim m, rng As Range, sht As Worksheet 
    Dim element As Variant 

    Set sht = ActiveSheet 

    SearchArray = Array("ISBN", "Sub Title", _ 
    "Paper Cut Off", "Despatch Date (ExW)", "Printer Location", "UK WHETA", _ 
    "Suggested Pub ExW", "Suggested Pub ExUK", "INDENT/STATUS", _ 
    "UK VAT Price", "FX", "GB Net Price", "AU Price + Freight", "S/A", _ 
    "Discount", "PRICE NOTES", "ORDERED", "Budget Value", "Misc Specs") 

    For Each element In SearchArray 
     m = Application.Match(element, sht.Rows(3), 0) 
     If Not IsError(m) Then 
      If rng Is Nothing Then 
       Set rng = sht.Columns(m) 
      Else 
       Set rng = Application.Union(rng, sht.Columns(m)) 
      End If 
     End If 
    Next element 

    If Not rng Is Nothing Then rng.Hidden = doHide 

    sht.Range("A1").Select 

End Sub 

훨씬 더 일반적인 만들 수있는 (검증되지 않은) 같은 것을 할 것이며, 헤더의 배열에 대한 하나 ...

Answer 2

이 나를 위해 작동합니다

Public Sub UnHideColumns() 

Dim ws As Worksheet 
Dim lastCell As Integer 
Dim DispSearchArray() As Variant 

Set ws = Sheets("Sheet1") 
lastCell = ws.Range("1:1").End(xlToRight).Column 
DispSearchArray = Array("ISBN", "Sub Title", "Paper Cut Off", "Despatch Date (ExW)", "Printer Location", "UK WH ETA", "Suggested Pub ExW", "Suggested Pub ExUK", "INDENT/STATUS", "UK VAT Price", "FX", "GB Net Price", "AU Price + Freight", "S/A", "Discount", "PRICE NOTES", "ORDERED", "Budget Value", "Misc Specs") 

For Each Header In DispSearchArray 
    For j = 1 To lastCell 
     If Cells(1, j) = Header Then 
      ws.Cells(1, j).Select 
      Selection.EntireColumn.Hidden = False 
     End If 
    Next j 
Next Header 

Set ws = Nothing 

End Sub 

,

좀 더 투명하게 느껴지지만 그건 저뿐입니다. 시도 해봐!