2016-06-24 1 views
1

입력 된 암호를 기반으로 Sheet1을 필터링하는 VBA 코드를 만들려고합니다. 나는 2 개의 시트를 가진 엑셀 파일을 가지고 있고 sheet2는 컬럼 B의 패스워드와 컬럼 A의 "필터"를 가지고있다. 나는 엑셀 파일을 배포하고 당사자들에게 해당 패스워드를 줄 것이고, 패스워드를 다른 사람들의 패스워드로 입력 할 것이다. 파티가 삭제됩니다. 코드 :VBA - 입력 된 암호를 기반으로 표시된 셀 필터링

Sub Open_with_password() 

pas = Application.InputBox("Input password") 
If pas = False Or pas = "" Then Exit Sub 
Application.ScreenUpdating = False 

a = 0 
For i = 1 To Sheet2.Range("A1").End(xlDown).Row 
    If Worksheets("Sheet2").Cells(i, 2) = pas Then 
     c = Worksheets("Sheet2").Cells(i, 1) 'the agency corresponding with the password 
     a = a + 1 
    End If 
Next 
'Check for password 
If a = 0 Then 
    MsgBox "Wrong password. Report can not be accessed" 
    ActiveWorkbook.Close False 

     Sheet2.Visible = xlSheetVeryHidden 
     Sheet1.Visible = xlSheetVeryHidden 

    Exit Sub 
    'If correct password 
Else: 
     Sheet1.Visible = xlSheetVisible 

     Worksheets("Sheet1").Select 
     Worksheets("Sheet1").Unprotect Password = "XYZ" 

     On Error Resume Next 
     ActiveSheet.ShowAllData 
     On Error GoTo 0 

    'Filter according to input password 
     If c <> "Admin" Then ActiveSheet.Range("$A$2:$AQ$500000").AutoFilter Field:=17, Criteria1:=c 
     Set rCell = ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1) 
     Rows(rCell.Row).Select 
     Range(Selection, Selection.End(xlDown)).Copy 
     Worksheets("Sheet1").Select 
     Range("A2").Select 
     Selection.PasteSpecial Paste:=xlPasteValues, _ 
     Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Range("A2").Select 
    'If Admin 
     If c = "Admin" Then 
     Sheet2.Visible = xlSheetVisible 
     Sheet1.Visible = xlSheetVisible 
     End If 

End If 

Application.ScreenUpdating = True 

End Sub 

내가 지금까지 만난 문제는 다음과 같습니다 내가 파일을 열 때 사용자가 아무 것도 볼 수 없습니다 동안
1. 입력 상자가 자동으로 표시되지 않습니다, 이상적으로는 보여줄 것이다.
2. 다른 모든 것을 삭제한다고 생각되는 부분에 도달하면 암호 (필터 작동)에 따라 필터링합니다. 내가

많은

답변

0

제안 :

통합 문서를 열면 매크로가 호출됩니다.

 
Private Sub Workbook_Open() 
    Open_with_password 
End Sub 

데이터를 숨겨진 워크 시트에 그대로 보관합니다.

Sheet1.Visible = xlSheetVeryHidden

복사 다른 워크 시트

 
Set rCell = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible) 
rcell.Copy Sheet2.Range("A1") 

통합 문서 분명 시트 2가 종료에 필터링 된 세포.

 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Sheet2.Cells.ClearContents 
End Sub 

당신이 이런 식으로 할 경우 사용자가 매크로를 사용하지 않고 통합 문서를 열 때 숨겨진 데이터에 액세스 할 수 없습니다.

0

1.Code가 Workbook_Open() 이벤트에 있어야 당신의 도움에 대한 감사 (오류 1004)은 복사 및 붙여 넣기 방법 및 오류 팝을 사용하고, 다른 서브 - 내 제안에 대한 호출을 할 수 있습니다 -. "에서 ThisWorkbook"개체에서 : 당신은 복사 - 붙여 넣기를 사용하는 경우

Private Sub Workbook_Open() 
Call Open_with_password 
End Sub 

2. 당신은 당신에게 따라서, (엑셀 VBA에서 정상적인 동작) 클립 보드를 잃은 그럴 경우, 중간에 선택을 할 수 없습니다 붙여 넣을 것이 없으므로 오류가 발생합니다.

Rows(rCell.Row).Select 
     Range(Selection, Selection.End(xlDown)).Copy 
     Sheets("Sheet1").Range("A2").PasteSpecial Paste:=xlPasteValues 
     Excel.Application.CutCopyMode = False 'clears clipboard 

편집에 대한

Rows(rCell.Row).Select 
     Range(Selection, Selection.End(xlDown)).Copy 
     Worksheets("Sheet1").Select 
     Range("A2").Select 'lost clipboard 
     Selection.PasteSpecial Paste:=xlPasteValues, _ 
     Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Range("A2").Select 

변경 : 필터 여부가있는 경우 enter image description here

그것은 상관없이 작동합니다.
OT : 다음 단계는 선택을 피하는 방법을 검색하는 것입니다 (시간이 많이 소요됨).

+0

도와 주셔서 감사합니다에 대한 당신의 대답은 암호 부분을 해결 @Sgdva. 나는 그것을 "사적인"것으로 잊었다. Howver 그것은 여전히 ​​다음 라인에 오류 1004를주었습니다 :'Selection.PasteSpecial Paste : = xlPasteValues, ' 복사 & 붙여 넣기 영역이 겹칠 수 없다고 말하면서 원하는 모든 행을 선택하고 붙여 넣지 않습니다. – Tiago

+0

'Selection.PasteSpecial'을 사용하지 않았습니다. 게시 된 코드와 정확히 일치합니까? 영역이 겹칩니다. 셀을 병합 했습니까? – Sgdva

+0

나에게 준 내용을 정확히 복사했으며 다른 데이터 위에 복사하지 않습니다. 어쩌면 필터로 인해 ... – Tiago

0

나는 다음과 같은 솔루션을 사용 나는 내 자신의 질문에 대답하고 그것은 작동하는 것 같군 :

Private Sub Workbook_Open() 
Call Open_with_password 
End Sub 

&

Sub Open_with_password() 
     Sheet2.Visible = xlSheetHidden 
     Sheet1.Visible = xlSheetHidden 
     Sheet3.Cells.ClearContents 
     Sheet1.Range("A1", "AQ1").Copy 
     Sheet3.Range("A1").PasteSpecial Paste:=xlPasteValues 

     Application.ScreenUpdating = False 
pas = Application.InputBox("Input password") 


If pas = False Or pas = "" Then Exit Sub 

a = 0 
For i = 1 To Sheet2.Range("A1").End(xlDown).Row 
    If Worksheets("Sheet2").Cells(i, 2) = pas Then 
     c = Worksheets("Sheet2").Cells(i, 1) 'the agency corresponding with the password 
     a = a + 1 
    End If 
Next 
'Check for password 
If a = 0 Then 
    MsgBox "Wrong password. Report can not be accessed" 
    ActiveWorkbook.Close False 

     Sheet2.Visible = xlSheetVeryHidden 
     Sheet1.Visible = xlSheetVeryHidden 

    Exit Sub 
    'If correct password 
Else: 
     Sheet1.Visible = xlSheetVisible 

     Worksheets("Sheet1").Select 
     Worksheets("Sheet1").Unprotect Password = "amazon" 

     On Error Resume Next 
     ActiveSheet.ShowAllData 
     On Error GoTo 0 

    'Filter according to input password 
     If c <> "Admin" Then ActiveSheet.Range("$A$2:$AQ$500000").AutoFilter Field:=17, Criteria1:=c 
     Set rCell = ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1) 
     Rows(rCell.Row).Select 
     Range(Selection, Selection.End(xlDown)).Copy 
     Sheets("Sheet3").Range("A2").PasteSpecial Paste:=xlPasteValues 
     Excel.Application.CutCopyMode = False 'clears clipboard 
     Sheet1.Visible = xlSheetVeryHidden 
    'If Admin 
     If c = "Admin" Then 
     Sheet2.Visible = xlSheetVisible 
     Sheet1.Visible = xlSheetVisible 
     End If 

End If 

Application.ScreenUpdating = True 

End Sub