excel - 密码生成器公式

Question

我有以下代码，可以在.xlsm文件中正常工作，但是当我将代码复制到Personal.xls文件中时，它不再起作用。我搜索了该论坛并找到了类似的主题，但是似乎没有一个主题可以解决我的问题。

我确定您可以看到我的代码是随机创建密码的(20个字符的日志，但为此我修改了公式以仅显示3个字符)。

Sub Password_Generator()

Application.ScreenUpdating = False

Sheets.Add.Name = "Password"

Range("B1").Value = "A"
Range("B2").Value = "B"
Range("B3").Value = "C"
Range("B4").Value = "D"
Range("B5").Value = "E"
Range("B6").Value = "F"
Range("B7").Value = "G"
Range("B8").Value = "H"
Range("B9").Value = "I"
Range("B10").Value = "J"
Range("B11").Value = "K"
Range("B12").Value = "L"
Range("B13").Value = "M"
Range("B14").Value = "N"
Range("B15").Value = "O"
Range("B16").Value = "P"
Range("B17").Value = "Q"
Range("B18").Value = "R"
Range("B19").Value = "S"
Range("B20").Value = "T"
Range("B21").Value = "U"
Range("B22").Value = "V"
Range("B23").Value = "W"
Range("B24").Value = "X"
Range("B25").Value = "Y"
Range("B26").Value = "Z"
Range("B27").Value = "a"
Range("B28").Value = "b"
Range("B29").Value = "c"
Range("B30").Value = "d"
Range("B31").Value = "e"
Range("B32").Value = "f"
Range("B33").Value = "g"
Range("B34").Value = "h"
Range("B35").Value = "i"
Range("B36").Value = "j"
Range("B37").Value = "k"
Range("B38").Value = "l"
Range("B39").Value = "m"
Range("B40").Value = "n"
Range("B41").Value = "o"
Range("B42").Value = "p"
Range("B43").Value = "q"
Range("B44").Value = "r"
Range("B45").Value = "s"
Range("B46").Value = "t"
Range("B47").Value = "u"
Range("B48").Value = "v"
Range("B49").Value = "w"
Range("B50").Value = "x"
Range("B51").Value = "y"
Range("B52").Value = "z"
Range("B53").Value = "1"
Range("B54").Value = "2"
Range("B55").Value = "3"
Range("B56").Value = "4"
Range("B57").Value = "5"
Range("B58").Value = "6"
Range("B59").Value = "7"
Range("B60").Value = "8"
Range("B61").Value = "9"
Range("B62").Value = "0"
Range("B63").Value = "!"
Range("B64").Value = "£"
Range("B65").Value = "$"
Range("B66").Value = "%"
Range("B67").Value = "&"
Range("B68").Value = "*"

Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("A1:A3").Select
    Selection.AutoFill Destination:=Range("A1:A68"),       Type:=xlFillDefault
    Range("A1:A68").Select

Columns("A:B").Select
    Selection.EntireColumn.Hidden = True

Columns("G").Select
    Selection.ColumnWidth = 35

Range("G2").Value = "PASSWORD"
Range("G4").Value = "Select F9 to generate a new password"


Range("G3").Formula = "=VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)

Range("G2:G4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Range("G2").Select
    Selection.Font.Bold = True
    Range("G4").Select
    Selection.Font.Italic = True
    Selection.Font.Size = 9
    Range("G3").Copy

Application.ScreenUpdating = False

End Sub

Answer 1

您必须指定要在哪个工作簿中添加工作表，并为所有范围指定一个工作簿

Dim wsNew As Worksheet
Set wsNew = ActiveWorkbook.Worksheets.Add 
wsNew.Name = "Password"

您可以通过以下方式访问该工作表上的范围

wsNew.Range("A1").FormulaR1C1 = "1"

请注意，应避免使用 .Select，因为这是一种不好的做法(请参阅 How to avoid using Select in Excel VBA)。

对每个Range，Cells，Columns，Rows等对象应用此技术(指定工作表并删除select)。

还要注意，您可以通过更短的循环来减少所有这些 Range("B1").Value = "A"语句:

Const Letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!£$%&*"

Dim iLetter As Long
For iLetter = 1 To Len(Letters)
    wsNew.Cells(iLetter, "B").Value = Mid$(Letters, iLetter, 1)
Next iLetter

您最终会得到类似的结果，它应该可以工作:

Sub Password_Generator()
    Application.ScreenUpdating = False

    Dim wsNew As Worksheet

    On Error GoTo ERR_ADDSHEET 'catch error if worksheet exists
    Set wsNew = Worksheets.Add
    On Error GoTo 0 're-enable error reporting

    wsNew.Name = "Password"

    Const Letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!£$%&*"

    Dim iLetter As Long
    For iLetter = 1 To Len(Letters)
        wsNew.Cells(iLetter, "B").Value = Mid$(Letters, iLetter, 1)
    Next iLetter

    With wsNew
        .Range("A1").Value = "1"
        .Range("A2").Value = "2"
        .Range("A3").Value = "3"
        .Range("A1:A3").AutoFill Destination:=.Range("A1:A" & Len(Letters)), Type:=xlFillDefault

        .Columns("A:B").EntireColumn.Hidden = True
        .Columns("G").ColumnWidth = 35

        .Range("G2").Value = "PASSWORD"
        .Range("G4").Value = "Select F9 to generate a new password"

        .Range("G3").Formula = "=VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)"

        .Range("G2:G4").HorizontalAlignment = xlCenter
        .Range("G2:G4").VerticalAlignment = xlCenter

        .Range("G2").Font.Bold = True
        .Range("G4").Font.Italic = True
        .Range("G4").Font.Size = 9
        .Range("G3").Copy
    End With

ERR_ADDSHEET:
    Application.ScreenUpdating = True

    If Err.Number > 0 Then MsgBox "Worksheet could not be added.", vbCritical
End Sub