Question

我（尝试）创建一个VBA代码，根据输入的密码过滤Sheet1。我有一个带有2个表格的excel文件，而sheet2在B列中有密码，而＃34;过滤器＆＃34;在A栏中，我将分发excel文件并向各方提供相应的密码，当他们输入密码时，其他各方的所有信息都将被删除。代码：

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.当它根据密码（过滤器工作）过滤到达其想要删除其他所有内容的部分时，它不会。我正在使用复制和粘贴方法并弹出错误（错误1004）

非常感谢您的帮助

Answer 1

1.Code应该在Workbook_Open()事件上，你可以打电话给另一个子建议 - 。在“ThisWorkbook”对象中：

Private Sub Workbook_Open()
Call Open_with_password
End Sub

2。如果你使用复制粘贴，你不能在中间进行选择，这样做会丢失剪贴板（excel VBA中的正常行为），因此你将无需粘贴，因此错误。

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

更改

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

修改

无论是否有过滤器，都应该有效。
OT：下一步你将会搜索如何避免选择（这是非常耗时的）。

Answer 2

建议：

当工作簿打开时，请调用您的宏。

Private Sub Workbook_Open()
    Open_with_password
End Sub

我会将您的数据保存在隐藏的工作表中。

Sheet1.Visible = xlSheetVeryHidden

将过滤的单元格复制到其他工作表

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

当工作簿关闭时，清除Sheet2。

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

如果这样做，用户在打开工作簿而不启用宏时将无法访问隐藏数据。

Answer 3

我正在回答我自己的问题，因为我使用了以下解决方案，它似乎正在起作用：

<input type="radio">

＆安培;

Private Sub Workbook_Open()
Call Open_with_password
End Sub

VBA - 根据输入的密码过滤显示的单元格

3 个答案: