纯文本转CSV的VBA代码调试：仅生成表头无数据问题

问题场景 #

需将含SF开头航班号（如SF1234）的纯文本文件转换为CSV，日期处理规则：

• 若日期字符串为19APR23 19APR23，生成单条19/04/2023日期数据
• 若为19APR23 21APR23，生成起始到结束日期的所有行（共3行）
  现有代码仅生成CSV表头，无数据内容，需修复。

核心问题排查 #

1. 日期格式识别失败：VBA内置IsDate函数无法识别DDMMMYY（如19APR23）这种缩写日期格式，导致日期行未进入处理分支，这是无数据输出的主要原因。
2. 日期字符串截取错误：处理双日期时，原代码用Right(FlightDates,2)获取年份，会错误提取整个字符串的最后两位（对应第二个日期的年份），而非每个日期各自的年份；同时提取第二个日期日份的Mid(FlightDates,10,2)位置错误，应该是Mid(FlightDates,9,2)。
3. 无空行过滤：文本文件中的空行可能干扰逻辑，需先过滤无效行。

修正后的完整代码 #

Option Explicit

Sub ImportSSMData()
Dim SSMFileName As Variant
Dim SSMFile As Integer
Dim SSMContent As String
Dim SSMData() As String
Dim FlightNum As String
Dim FlightDates As String
Dim StartDate As Date
Dim EndDate As Date
Dim CurrentDate As Date
Dim OutputWorkbook As Workbook
Dim OutputWorksheet As Worksheet
Dim OutputRow As Long
Dim i As Long

SSMFileName = Application.GetOpenFilename(FileFilter:="All Files (*.*), *.*", Title:="Select the SSM file")

If SSMFileName = False Then
    Exit Sub
End If

SSMFile = FreeFile
Open SSMFileName For Input As SSMFile
SSMContent = Input(LOF(SSMFile), SSMFile)
Close SSMFile

SSMData = Split(SSMContent, vbCrLf)

Set OutputWorkbook = Workbooks.Add
Set OutputWorksheet = OutputWorkbook.Worksheets(1)

OutputRow = 1
OutputWorksheet.Cells(OutputRow, 1).Value = "Flight Number"
OutputWorksheet.Cells(OutputRow, 2).Value = "Flight Date"
OutputWorksheet.Cells(OutputRow, 3).Value = "Template"
OutputWorksheet.Cells(OutputRow, 4).Value = "Widget"

For i = LBound(SSMData) To UBound(SSMData)
    ' 过滤空行和无效行
    If Trim(SSMData(i)) <> "" Then
        If Left(Trim(SSMData(i)), 2) = "SF" Then
            FlightNum = Trim(SSMData(i))
        Else
            FlightDates = Trim(SSMData(i))
            ' 跳过长度不足7的无效日期行
            If Len(FlightDates) >= 7 Then
                ' 处理双日期情况（长度>=14，含空格）
                If Len(FlightDates) >= 14 Then
                    ' 解析起始日期
                    StartDate = DateSerial( _
                        CInt(Right(Mid(FlightDates, 1, 7), 2)) + 2000, _
                        MonthNameToNumber(Mid(FlightDates, 4, 3)), _
                        CInt(Left(FlightDates, 2)) _
                    )
                    ' 解析结束日期
                    EndDate = DateSerial( _
                        CInt(Right(Mid(FlightDates, 9, 7), 2)) + 2000, _
                        MonthNameToNumber(Mid(FlightDates, 12, 3)), _
                        CInt(Mid(FlightDates, 9, 2)) _
                    )
                    ' 生成所有日期行
                    For CurrentDate = StartDate To EndDate
                        OutputRow = OutputRow + 1
                        OutputWorksheet.Cells(OutputRow, 1).Value = FlightNum
                        OutputWorksheet.Cells(OutputRow, 2).Value = Format(CurrentDate, "dd/mm/yyyy")
                    Next CurrentDate
                Else
                    ' 处理单日期情况
                    StartDate = DateSerial( _
                        CInt(Right(FlightDates, 2)) + 2000, _
                        MonthNameToNumber(Mid(FlightDates, 4, 3)), _
                        CInt(Left(FlightDates, 2)) _
                    )
                    OutputRow = OutputRow + 1
                    OutputWorksheet.Cells(OutputRow, 1).Value = FlightNum
                    OutputWorksheet.Cells(OutputRow, 2).Value = Format(StartDate, "dd/mm/yyyy")
                End If
            End If
        End If
    End If
Next i

Dim CSVFileName As Variant

CSVFileName = Application.GetSaveAsFilename( _
    InitialFileName:=Replace(SSMFileName, ".txt", ".csv"), _
    FileFilter:="CSV Files (*.csv), *.csv", _
    Title:="Save the CSV file")

If CSVFileName <> False Then
    OutputWorkbook.SaveAs fileName:=CSVFileName, FileFormat:=xlCSV, CreateBackup:=False
    OutputWorkbook.Close SaveChanges:=False
Else
    MsgBox "未指定文件名，文件未保存。", vbExclamation, "保存取消"
End If
End Sub

Function MonthNameToNumber(MonthName As String) As Integer
Dim MonthNumber As Integer
Dim MonthNames As Variant
MonthNames = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

For MonthNumber = LBound(MonthNames) To UBound(MonthNames)
    If UCase(MonthName) = MonthNames(MonthNumber) Then
        MonthNameToNumber = MonthNumber + 1
        Exit Function '找到后立即退出，避免循环多余步骤
    End If
Next MonthNumber
' 未找到时返回0（可根据需求调整）
MonthNameToNumber = 0
End Function

关键修改说明 #

• 移除了无效的IsDate判断，改为通过长度判断日期行，直接解析DDMMMYY格式
• 修正了日期字符串的截取位置，确保每个日期的日、月、年都正确提取
• 添加了Trim()处理，过滤文本中的空格和空行
• 年份处理时添加+2000，确保23年解析为2023而非1923
• 优化了MonthNameToNumber函数，找到匹配月份后立即退出循环

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