VBA导入CSV至最后一行报错：Subscript out of range

错误核心原因 #

这个报错通常是因为代码引用了不存在的对象（工作表、工作簿等），结合你的业务场景和代码，重点排查以下4个点：

1. 目标工作表「Services Data」不存在 #

代码直接调用ThisWorkbook.Worksheets("Services Data")，如果当前工作簿里没有完全匹配这个名称的工作表（包括大小写、空格），就会触发错误。

• 解决：打开存放宏的工作簿，确认存在名为Services Data的工作表，检查名称拼写和格式。

2. CSV文件工作表索引引用异常 #

你用OpenBook.Worksheets(1)取CSV的第一个工作表，但极少数情况下，CSV文件打开后可能没有工作表（或索引不对应）。

• 解决：在引用前增加工作表数量检查：

  If OpenBook.Worksheets.Count < 1 Then
      MsgBox "所选CSV文件无有效工作表！"
      OpenBook.Close SaveChanges:=False
      Exit Sub
  End If
  

3. 空CSV/仅表头导致的范围引用错误 #

如果CSV只有表头（第一行有数据，第二行及以下为空），LastCell函数会返回第一行单元格，此时.Range(.Cells(2,1), Source_LastCell)会出现「起始行大于结束行」的无效引用。

• 解决：复制前检查数据范围有效性：

  With OpenBook.Worksheets(1)
      If .Cells(2,1).Row > Source_LastCell.Row Then
          MsgBox "CSV仅含表头，无数据可导入！"
          OpenBook.Close SaveChanges:=False
          Exit Sub
      End If
  End With
  

4. 未处理文件选择取消的情况 #

虽然你判断了FileToOpen <> ""，但可以增加提示让HR员工更明确操作状态。

完整修复后的代码 #

Sub ImportSalesData()
    Dim FileToOpen As String
    FileToOpen = GetFileName
    
    If FileToOpen = "" Then
        MsgBox "未选择文件，操作已取消。"
        Exit Sub
    End If
    
    Dim OpenBook As Workbook
    Set OpenBook = Workbooks.Open(FileToOpen)
    
    ' 检查CSV是否有有效工作表
    If OpenBook.Worksheets.Count < 1 Then
        MsgBox "所选CSV文件无有效工作表！"
        OpenBook.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' 获取CSV最后单元格
    Dim Source_LastCell As Range
    Set Source_LastCell = LastCell(OpenBook.Worksheets(1))
    
    ' 检查目标工作表是否存在
    Dim Target_WS As Worksheet
    On Error Resume Next
    Set Target_WS = ThisWorkbook.Worksheets("Services Data")
    On Error GoTo 0
    If Target_WS Is Nothing Then
        MsgBox "未找到【Services Data】工作表，请检查！"
        OpenBook.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' 获取目标工作表最后单元格（偏移一行准备粘贴）
    Dim Target_LastCell As Range
    Set Target_LastCell = LastCell(Target_WS).Offset(1)
    
    ' 复制粘贴数据（先检查数据范围有效性）
    With OpenBook.Worksheets(1)
        If .Cells(2, 1).Row > Source_LastCell.Row Then
            MsgBox "CSV仅含表头，无数据可导入！"
            OpenBook.Close SaveChanges:=False
            Exit Sub
        End If
        .Range(.Cells(2, 1), Source_LastCell).Copy _
            Destination:=Target_WS.Cells(Target_LastCell.Row, 1)
    End With
    
    MsgBox "数据导入完成！"
    OpenBook.Close SaveChanges:=False
End Sub

Public Function GetFileName() As String
    Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    
    With FD
        .InitialFileName = ThisWorkbook.Path & Application.PathSeparator
        .AllowMultiSelect = False
        .Filters.Add "CSV文件", "*.csv", 1 ' 仅显示CSV，避免选错文件
        If .Show = -1 Then
            GetFileName = .SelectedItems(1)
        End If
    End With
    
    Set FD = Nothing
End Function

Public Function LastCell(wrkSht As Worksheet) As Range
    Dim lLastCol As Long, lLastRow As Long
    
    On Error Resume Next
    With wrkSht
        lLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        lLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    End With
    On Error GoTo 0
    
    If lLastCol = 0 Then lLastCol = 1
    If lLastRow = 0 Then lLastRow = 1
    
    Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End Function

额外优化说明 #

• 给文件选择框添加CSV过滤，避免HR选错格式
• 增加多处弹窗提示，让操作结果更直观
• 增加错误捕获逻辑，避免程序意外崩溃

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