Question

我的代码在创建新工作表时工作正常，但是代码的下一部分不能正常工作，我给出了要在工作表123中输入的某些字段，但仅在单元格中输入了值“备注” A1即只有最后一个字段。问题是什么？

我不明白。

Sub CreateSheet()



Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter a name for this new sheet ")
If xName = "" Then Exit Sub
    Set xSht = Sheets(xName)
    If Not xSht Is Nothing Then
        MsgBox "Sheet cannot be created as there is already a worksheet with the same name in this workbook"
        Exit Sub
        End If
        Sheets.Add(, Sheets(Sheets.Count)).Name = xName


        Sheets("New Ledger Creator").Activate


         Dim lastrow As Long
    lastrow = Range("b" & Rows.Count).End(xlUp).Row
    Range("b" & lastrow + 1).Select

    Selection = xName



Sheets("123").Select


Range("A1").Select
Selection.Value = "Paid"
Range("A2").Select

Selection.Value = "Date"
Range("B2").Select
Selection.Value = "For"
Range("C2").Select
Selection.Value = "Through"
Range("D2").Select
Selection.Value = "Amount"
Range("E2").Select
Selection.Value = "Remarks"
Range("F2").Select
Selection.Value = "Date"
Range("G2").Select
Selection.Value = "For"
Range("H2").Select
Selection.Value = "Through"
Range("I2").Select
Selection.Value = "Amount"
Range("J2").Select
Selection.Value = "Remarks"
Range("A1:E1").Select

End Sub

Answer 1

玩了一会儿，并想出了下面的代码。显示不使用Select并摆脱On Error Resume Next。

Option Explicit 'VERY IMPORTANT!!!!!!!!
                'Place at top of every new module by selecting Tools ~ Options and ticking
                'Require Variable Declaration.

Sub CreateSheet()

    Dim xName As String
    Dim xSht As Object
    Dim IllegalCharacters As Variant
    Dim iChr As Variant
    Dim shtNew As Worksheet
    Dim shtLCreator As Worksheet

    On Error GoTo Err_Handle

    IllegalCharacters = Array("/", "\", "[", "]", "*", "?", ":")
    xName = InputBox("Please enter a name for this new sheet.")

    'Remove any illegal characters from sheet name.
    For Each iChr In IllegalCharacters
        xName = Replace(xName, iChr, "")
    Next iChr

    If Len(xName) > 0 Then
        If WorkSheetExists(xName) Then
            MsgBox "Cannot create sheet '" & xName & "' as it already exists.", vbOKOnly + vbCritical
        Else
            Set shtNew = ThisWorkbook.Worksheets.Add
            shtNew.Name = xName

            Set shtLCreator = ThisWorkbook.Worksheets("New Ledger Creator")
            shtLCreator.Cells(Rows.Count, 2).End(xlUp).Offset(1) = xName

            With ThisWorkbook.Worksheets("123")
                .Range("A1") = "Paid"
                .Range("A2:J2") = Array("Paid", "Date", "For", "Through", "Amount", _
                                        "Remarks", "Date", "For", "Through", "Amount", "Remarks")
            End With
        End If
    End If

FAST_EXIT:

Exit Sub

Err_Handle:
    Select Case Err.Number
        Case 11 'Division by 0

            MsgBox "Somehow a division by 0 happened." & vbCr & _
                   "Well done, you did the impossible - there's no calculations in this code.", vbOKOnly

            'Resume Next 'Error was dealt with, so continue on line following error.
            'Resume 'Error was dealt with so continue on same line that caused error.
            Resume FAST_EXIT 'Error was dealt with, resume at Fast_Exit label.

        Case Else
            MsgBox Err.Description, vbOKOnly + vbCritical, Err.Number
    End Select

End Sub

'Checks if a worksheet exists - returns TRUE/FALSE
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
    Dim wrkSht As Worksheet

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    On Error Resume Next
        Set wrkSht = WrkBk.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

Answer 2

我尝试了您的代码，它实际上填充了所有字段（“付费”，“日期”）...

但是，清理一下代码，对您有用吗？

Option Explicit

Sub CreateSheet()



Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter a name for this new sheet ")
If xName = "" Then Exit Sub
    Set xSht = Sheets(xName)
    If Not xSht Is Nothing Then
        MsgBox "Sheet cannot be created as there is already a worksheet with the same name in this workbook"
        Exit Sub
        End If
        Sheets.Add(, Sheets(Sheets.Count)).Name = xName


        'Sheets("New Ledger Creator").Activate


         Dim lastrow As Long
    lastrow = Range("b" & Rows.Count).End(xlUp).Row
    Range("b" & lastrow + 1).Select

    'Selection = xName



'Sheets("123").Select

With Worksheets(xName) 'I assume that all the headers will be populated in the new worksheet that has been created.
.Range("A1").Value = "Paid"
.Range("A2").Value = "Date"
.Range("B2").Value = "For"
.Range("C2").Value = "Through"
.Range("D2").Value = "Amount"
.Range("E2").Value = "Remarks"
.Range("F2").Value = "Date"
.Range("G2").Value = "For"
.Range("H2").Value = "Through"
.Range("I2").Value = "Amount"
.Range("J2").Value = "Remarks"
End With


'Range("A1:E1").Select

End Sub

我的代码未在必填表中输入该字段

2 个答案: