VBA 用户窗体编程脚本

Question

我正在尝试使用确切的 sheet 名称作为输入来使此代码在 excel 中打开特定的 sheet。如果 sheet 名称不存在或拼写错误，它应该显示 "Please use another Sheet name" 消息。到目前为止我有这个，但是 "Case Else" 部分给我带来了问题。感谢您的帮助。

Private Sub CommandButton1_Click()
Dim Sheetname As String
whichSheet = InputBox("In which sheet do you wish to enter data? Specify sheet number as Toner, Copy Paper,etc.", "Input")
Dim ws As Worksheet
For Each ws In Worksheets
    Select Case ws.CodeName
        Case "Toner", "Copy Paper", "Mail Package", "Alteration", "Gloves", "Special Requests"
            Worksheets(whichSheet).Activate ws.Name
        Case Else
            MsgBox "Please use another Sheet name"
            Exit Sub
    End Select
Next ws

Worksheets(whichSheet).Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

lastrow = lastrow + 1
Cells(lastrow, 1) = TextBox1
If Application.WorksheetFunction.CountIf(Range("A2:A" & lastrow), Cells(lastrow, 1)) > 1 Then
MsgBox "Submitting Entry"
Cells(lastrow, 1) = ""

Cells(lastrow, 1) = TextBox1.Text
Cells(lastrow, 2) = TextBox2.Text
Cells(lastrow, 3) = TextBox3.Value
Cells(lastrow, 4) = TextBox4.Text
Cells(lastrow, 5) = TextBox5.Text
End If


End Sub

Answer 1

试试这个，它建立在以前的代码之上，并且避免激活 sheet。这样做不是世界末日，但没有必要。

Private Sub CommandButton1_Click()

Dim whichSheet As String, lastrow As Long

whichSheet = InputBox("In which sheet do you wish to enter data? Type in sheet name as Toner, Copy Paper, Alteration, Mail Package, Gloves, and Special Requests.", "Input")

Select Case whichSheet
    Case "Toner", "Copy Paper", "Mail Package", "Alteration", "Gloves", "Special Requests"
        With Worksheets(whichSheet)
            lastrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lastrow, 1) = TextBox1
            If Application.WorksheetFunction.CountIf(.Range("A2:A" & lastrow), .Cells(lastrow, 1)) > 1 Then
                MsgBox "Submitting Entry"
                .Cells(lastrow, 1) = ""
                .Cells(lastrow, 1) = TextBox1.Text
                .Cells(lastrow, 2) = TextBox2.Text
                .Cells(lastrow, 3) = TextBox3.Value
                .Cells(lastrow, 4) = TextBox4.Text
                .Cells(lastrow, 5) = TextBox5.Text
            End If
        End With
    Case Else
        MsgBox "Please use another Sheet name"
        Exit Sub
End Select

End Sub

VBA 用户窗体编程脚本

VBA Userform programming script

excel

vba

userform