VBA技术实现：基于文件名创建工作表

I've got you covered! Below is a complete VBA macro that meets all your requirements, plus some error handling to make it more robust. Let's break it down step by step:

How it works #

1. Scan target folder for .xlsx files: Uses the Dir function to loop through the folder and filter only files ending with .xlsx
2. Store filenames in an array: Dynamically builds an array to hold all valid filenames (no need to predefine the array size!)
3. Create worksheets from the array: Loops through the array and creates a worksheet for each filename, with checks to avoid duplicate sheet names

Full Macro Code #

Sub CreateSheetsFromXLSXFilenames()
    Dim targetFolder As String
    Dim fileName As String
    Dim fileNamesArray() As String
    Dim arrayIndex As Integer
    Dim ws As Worksheet
    
    ' --- Step 1: Set your target folder path (update this to your folder!) ---
    targetFolder = "C:\Your\Target\Folder\Path\" ' Make sure to include the trailing backslash
    
    ' Validate folder path
    If Right(targetFolder, 1) <> "\" Then targetFolder = targetFolder & "\"
    If Dir(targetFolder, vbDirectory) = "" Then
        MsgBox "Error: Target folder does not exist!", vbCritical
        Exit Sub
    End If
    
    ' --- Step 2: Scan folder and collect .xlsx filenames ---
    arrayIndex = 0
    fileName = Dir(targetFolder & "*.xlsx")
    
    Do While fileName <> ""
        ' Resize array to add new element
        ReDim Preserve fileNamesArray(arrayIndex)
        ' Store filename (without the .xlsx extension if you prefer, remove the Left function to keep it)
        fileNamesArray(arrayIndex) = Left(fileName, Len(fileName) - 5)
        ' Get next file
        fileName = Dir()
        arrayIndex = arrayIndex + 1
    Loop
    
    ' Check if any files were found
    If arrayIndex = 0 Then
        MsgBox "No .xlsx files found in the target folder!", vbInformation
        Exit Sub
    End If
    
    ' --- Step 3: Create worksheets from the array ---
    Application.ScreenUpdating = False ' Speed up macro by disabling screen updates
    
    On Error Resume Next ' Temporarily ignore errors (for duplicate sheet names)
    For arrayIndex = LBound(fileNamesArray) To UBound(fileNamesArray)
        ' Try to create the worksheet
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = fileNamesArray(arrayIndex)
        
        ' If sheet name is invalid or duplicate, notify user
        If Err.Number <> 0 Then
            MsgBox "Could not create sheet named """ & fileNamesArray(arrayIndex) & """: " & _
                   "Name may be duplicate or contain invalid characters.", vbExclamation
            Err.Clear
            Application.DisplayAlerts = False
            ws.Delete ' Delete the blank sheet we tried to create
            Application.DisplayAlerts = True
        End If
    Next arrayIndex
    On Error GoTo 0 ' Reset error handling
    
    Application.ScreenUpdating = True ' Re-enable screen updates
    MsgBox "Done! Created " & (arrayIndex) & " worksheets.", vbInformation
End Sub

Key Notes & Customizations #

• Update the folder path: Make sure to change the targetFolder variable to your actual folder path (don't forget the trailing backslash!)
• Keep or remove file extension: The code currently strips the .xlsx extension from the sheet name. If you want to keep it, remove the Left(fileName, Len(fileName) - 5) part and just use fileName instead
• Error handling: The macro checks for duplicate sheet names and invalid characters (like /:*?"<>| which aren't allowed in sheet names)
• Performance: Disabling ScreenUpdating makes the macro run much faster, especially if you have many files

Just paste this code into your workbook's VBA editor (press Alt + F11 to open it), update the folder path, and run the macro!

内容的提问来源于stack exchange，提问作者TurboCoder