VBA导出非空列数据到文本文件异常：仅复制首行且含公式空单元格

你的代码存在两个核心问题，同时还有一个隐藏的路径拼接错误，下面是修复后的代码，以及问题的具体说明：

修复后的VBA代码 #

Sub Addtotext() 'Adds stocks to stockslist for python
    Dim strPath As String
    Dim strName As String
    Dim FSO As Object
    Dim oFile As Object
    Dim c As Range
    Dim rng As Range
    
    ' 定义J列的目标范围（从J2到J列最后一个有数据的单元格）
    Set rng = Range("J2", Range("J" & Rows.Count).End(xlUp))
    
    strName = "a.txt"
    strPath = "C:\Volume\PythonProjects\" ' 末尾添加反斜杠，避免路径拼接错误
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = FSO.CreateTextFile(strPath & strName)
    
    ' 遍历目标范围，只写入非空单元格（排除公式返回的空值）
    For Each c In rng
        If Trim(c.Value) <> "" Then ' 用Trim避免空格导致的误判
            oFile.Write c.Value & " "
        End If
    Next c
    
    oFile.Close
    Set oFile = Nothing
    Set FSO = Nothing
    Set rng = Nothing
End Sub

问题修复说明 #

• 问题1：包含公式返回的空单元格
  原代码没有判断单元格的实际值是否为空，直接复制范围后遍历。修复时通过Trim(c.Value) <> ""检查单元格内容，既排除了纯空单元格，也过滤了公式返回空文本的单元格。

• 问题2：仅复制首行数据
  原代码依赖Selection对象，但Copy操作并不会自动将选中范围改为复制的区域，导致遍历的Selection可能不是目标J列范围。修复时直接定义目标范围rng，遍历这个明确的范围，确保所有符合条件的单元格都被处理。

• 隐藏问题：路径拼接错误
  原代码中strPath末尾没有反斜杠，拼接后会变成C:\Volume\PythonProjectsa.txt，导致文件无法创建。修复时在strPath末尾添加了反斜杠，确保路径拼接正确。

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