工作和生活当中，不可避免要用到一些账号密码，对于忘记力不佳的人来说，实在是一件头痛的事情。

密码作为一个入门口令，又不能随便告诉别人，记不住又不能让别人来帮助记住，这就比较麻烦。

其实，用Excel文档来记录，也很方便，就是要对这个密码文档做一些加密，只记住这一个密码就可以了。

当然了，这也不是万无一失的办法，至少是一种方法，可能采纳。

密码管理

内容不是很多，主要包括：账户、密码、名称、 编号 、类别、 账号、 密码 、网络地址、 保密级别 、使用状态、使用人、 共享人 、修改次数等。

比如名称分类有银行账户，手机，微信，QQ，邮箱，网站等等。

平时注册多了就难免忘记了，这也不是什么稀奇的事情，我就经常忘记。

这个工具很好地实现了密码保存，修改，查询功能。

手机可以找回密码，没错，我就经常这么做。

一个手机就可以解决的问题，为什么要用这个工具，其实我也不知道。

感觉很白痴的样子，甚至习惯了不记密码。

认真总结了一下，所有用到密码加起来，真的很不好记，也记不住那么。

如果设置一些有规律的密码，也许还可以试错几次成功登录。

但是，这种有规律的密码，一旦数量增加，就没有规律可循了。

添加信息

分别对要设置密码的类型，状态，共享人，进行设置。

为了更全面地记录，也可以增加其它项目，这就是只想到这些。

作为一个启发，制作并不严谨，一些可能出现的错误，也没有补漏。

不想做到极致，只想做一个过程。

这种很不负责任的想法，让人没有思考的动力。

信息修改

修改只开放了账号和密码两个项目，其它就不用改了，实在不想要就注销，重新设置。

这里没有做删除用，一旦设置就不要修改了。

为长久保存，有些数据就是错了，也要保存错的内容。

代码

搜索代码

Private Sub T0_Change()
    Dim w As Worksheet
    Dim wRow As Integer, wCol As Integer
    Dim wR As Range, wRa As Range    Set w = ThisWorkbook.Worksheets("passwords")
    w.Activate
    wCol = w.Range("A1").End(xlToRight).Column
    wRow = w.Range("E65535").End(xlUp).Row    Set wR = w.Range("E2:E" & wRow)
    Dim x As Range
    Me.ListView1.ListItems.Clear    For Each x In wR        Set wRa = wR.Find(Me.T0.Value, LookIn:=xlValues, lookat:=xlPart)
        Dim lobj As Object, aDr As String, wRs As Range
        If Not wRa Is Nothing Then
            If x.Value = wRa.Value Then
                    With Me.ListView1
                         Dim i As Integer, c As Integer
                         i = wRa.Row                                Set lobj = .ListItems.Add                                With lobj
                                    .Text = w.Cells(i, 1).Value                                    For c = 1 To wCol - 1
                                         .SubItems(c) = w.Cells(i, c + 1).Value                                    Next c                                End With
                    End With
             End If
        End If
    Next xEnd Sub

注销代码

Private Sub CommandButton3_Click()
Dim Kname As String, keyID As String, Values As StringKname = Me.ListView1.SelectedItem.SubItems(1)
keyID = Me.ListView1.SelectedItem.SubItems(2)Values = Me.ListView1.SelectedItem.SubItems(8)
Dim unK As Integer
    Dim w As Worksheet
    Dim wRow As Integer, wCol As Integer
    Dim wR As Range, wRa As Range
    Set w = ThisWorkbook.Worksheets("passwords")
    w.Activate
    wRow = w.Range("A65535").End(xlUp).Row    Set wR = Range(Cells(2, 3), Cells(wRow, 3))    For Each wRa In wR        If wRa.Value = keyID Then
            unK = MsgBox("确定要注销?" & VBA.vbCrLf & Kname & VBA.vbCrLf & keyID, vbYesNo, "提示")            If unK <> 6 Then Exit Sub
            w.Cells(wRa.Row, 9).Value = "已经注销"
            ThisWorkbook.Save
            Unload Me
            UserForm1.Show        End If
    Next wRa