Question

我正在尝试创建一个VBE代码来创建一个新的Excel工作表。

要创建一个新的工作表我正在使用下面的代码并且工作正常：

    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count))
        ws.Name = "Savings"
    End With

但现在我需要将此代码更改为适用于此逻辑的IF条件：如果有一个名为“Savings”的工作表，请将其删除并创建一个名为“Savings”的新工作表，否则只需创建工作表“储蓄”。

在我创建工作表“Savings”后，我想保存为新文件，我想在另存为对话框的名称字段中建议一个名称（如Savings）。

谢谢你们一直帮助我

Answer 1

这会将工作表设置为您的变量并测试它是否存在。如果是这样，它将在使用您的代码创建新工作表之前将其删除。这种方式的好处是你不需要循环来实现它

Dim ws as worksheet

On Error Resume Next
Set ws = ThisWorkbook.Sheets("Savings")
On Error GoTo 0

If not ws is nothing then
    With Application
        ' Disable Alerts
        .DisplayAlerts = False
        ' Delete sheet
        ws.delete
        ' Re-enable Alerts
        .DisplayAlerts = True
    End With
End If

With ThisWorkbook
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count))
    ws.Name = "Savings"
End With

Answer 2

这应该可以解决问题：

Dim ws As Worksheet
With ThisWorkbook
    For Each ws In .Worksheets
        If ws.Name = "Savings" Then 'If Savings exists
            Application.DisplayAlerts = False 'Disable warnings
            ws.Delete 'Delete Worksheet
            Application.DisplayAlerts = True 'Enable warnings
            Exit For
        End If
    Next ws

    'Add Savings Worksheet
    Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    ws.Name = "Savings"
End With

With Application.FileDialog(msoFileDialogSaveAs) 'SaveAs Dialog
    .InitialFileName = "Savings" 'Suggested Name
    .AllowMultiSelect = False

    .Show
    If .SelectedItems.Count > 0 Then
        ThisWorkbook.SaveAs .SelectedItems(1) 'Save File
    End If
End With

Answer 3

这样的事情对你有用：

Sub tgr()

    Dim wsSav As Worksheet
    Dim sSavePath As String
    Dim sExt As String
    Dim lFileFormat As Long

    With ThisWorkbook
        On Error Resume Next    'Prevent error if worksheet doesn't exist
        Set wsSav = .Sheets("Savings")
        On Error GoTo 0         'Remove error condition

        If Not wsSav Is Nothing Then
            Application.DisplayAlerts = False   'Suppress "Are you sure?" worksheet delete prompt
            wsSav.Delete
            Application.DisplayAlerts = True
        End If
        Set wsSav = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        wsSav.Name = "Savings"

        sSavePath = Application.GetSaveAsFilename("Savings")
        If sSavePath = "False" Then Exit Sub    'user pressed cancel

        sExt = Mid(sSavePath, InStrRev(sSavePath, ".") + 1)
        If Len(sExt) = 0 Then
            sExt = "xlsm"
            sSavePath = sSavePath & sExt
        End If

        Select Case LCase(sExt)
            Case "xlsm":    lFileFormat = 52
            Case "xlsx":    lFileFormat = 51
            Case "xls":     lFileFormat = 56
            Case Else:
                MsgBox "Invalid Excel file extension """ & sExt & """" & Chr(10) & _
                       "Unable to save file."
                Exit Sub
        End Select

        Application.DisplayAlerts = False   'Suppress overwrite prompt (if any)
        .SaveAs sSavePath, lFileFormat
        Application.DisplayAlerts = True
    End With

End Sub

如何创建条件以创建Excel工作表

3 个答案: