VBA:无法将单元格值写入文本文件

我有一个现有的excel工作表，其中包含如下数据：

Col A  Col B        Col C
123    17/1/1993    ABC
124    18/1/1993    DEF
125    19/1/1993    AAD
126    20/1/1993    AIG
127    21/1/1993    GBI

我想将数据写入以制表符分隔的文本文件。使用以下代码，创建的文本文件不包含单元格中的值，尽管选项卡会写入文本文件

Sub writetotext()
    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Integer, j As Integer
    Dim celldata As String
    Dim fname As String
    Dim fso As Object

    Dim ws As Worksheet

    fname = ThisWorkbook.Path & "\textoutput.txt"
    lastrow = ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lastcol =        ThisWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
    Set ws = ThisWorkbook.Sheets(1)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFile = fso.CreateTextFile(fname)

    For i = 1 To lastrow
        For j = 1 To lastcol
            If j = lastcol Then
                celldata = celldata + ActiveCell(i, j).Value
            Else
                celldata = celldata + ActiveCell(i, j).Value + vbTab
            End If
        Next j
        objFile.writeline celldata
        celldata = ""
    Next i

    objFile.Close

End Sub

---

看起来像ActiveCell（i，j）。值不起作用，但我不知道如何纠正这个问题。我正在使用Excel 2010

您需要将

ActiveCell（I，j）

替换为

单元格（I，j）

此外，要组合文本，请使用

&

而不是

+

，因此您的行实际上应该看起来像

celldata=celldata&Cells（i，j）.Value&vbTab

Option Explicit

Sub writetotext()

    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Long, j As Long
    Dim celldata As String
    Dim fname As String
    Dim fso As Object, objFile As Object

    Dim ws As Worksheet

    fname = ThisWorkbook.Path & "\textoutput.txt"
    Set ws = ThisWorkbook.Sheets(1)

    lastrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lastcol = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Column

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFile = fso.CreateTextFile(fname)

    With ws
        For i = 1 To lastrow
            For j = 1 To lastcol
                If j = lastcol Then
                    celldata = celldata & .Cells(i, j).Value
                Else
                    celldata = celldata & .Cells(i, j).Value & vbTab
                End If
            Next j
            objFile.writeline celldata
            celldata = ""
        Next i
    End With

    objFile.Close

End Sub

---

您需要将

ActiveCell（i，j）

替换为

单元格（i，j）

此外，要组合文本，请使用

&

而不是

+

，因此您的行实际上应该看起来像

celldata=celldata&Cells（i，j）.Value&vbTab

Option Explicit

Sub writetotext()

    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Long, j As Long
    Dim celldata As String
    Dim fname As String
    Dim fso As Object, objFile As Object

    Dim ws As Worksheet

    fname = ThisWorkbook.Path & "\textoutput.txt"
    Set ws = ThisWorkbook.Sheets(1)

    lastrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lastcol = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Column

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFile = fso.CreateTextFile(fname)

    With ws
        For i = 1 To lastrow
            For j = 1 To lastcol
                If j = lastcol Then
                    celldata = celldata & .Cells(i, j).Value
                Else
                    celldata = celldata & .Cells(i, j).Value & vbTab
                End If
            Next j
            objFile.writeline celldata
            celldata = ""
        Next i
    End With

    objFile.Close

End Sub

---

您可以通过以下方式大大缩短代码的长度：

• 数组和

• 正在“动态”实例化

  FileSystemObject

  file对象

具体如下：

Option Explicit

Sub writetotext()
    Dim i As Long
    Dim dataArr As Variant

    dataArr = ThisWorkbook.Sheets(1).UsedRange.Value '<--| store all values in an array
    With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\textoutput.txt") '<--| instantiate a 'FileSystemObject' file object and reference it
        For i = 1 To UBound(dataArr, 1) '<--| loop through data array rows
            .writeline Join(Application.Index(dataArr, i, 0), vbTab) '<--| write current data array row values joined with vbtab delimeter
        Next i
        .Close '<--| close referenced instance of the 'FileSystemObject' file object
    End With
End Sub

选项显式
子写入文本（）
我想我会坚持多久
Dim dataArr作为变型
dataArr=ThisWorkbook.Sheets（1）.UsedRange.Value'您可以通过以下方式大大缩短代码的长度：


数组和

正在“动态”实例化
FileSystemObject
file对象


具体如下：

Option Explicit

Sub writetotext()
    Dim i As Long
    Dim dataArr As Variant

    dataArr = ThisWorkbook.Sheets(1).UsedRange.Value '<--| store all values in an array
    With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\textoutput.txt") '<--| instantiate a 'FileSystemObject' file object and reference it
        For i = 1 To UBound(dataArr, 1) '<--| loop through data array rows
            .writeline Join(Application.Index(dataArr, i, 0), vbTab) '<--| write current data array row values joined with vbtab delimeter
        Next i
        .Close '<--| close referenced instance of the 'FileSystemObject' file object
    End With
End Sub

选项显式
子写入文本（）
我想我会坚持多久
Dim dataArr作为变型
dataArr=ThisWorkbook.Sheets（1）.UsedRange.Value'
ActiveCell（i，j）.Value
确实有效，但它不是您想要使用的。例如，
ActiveCell（2，4）
指的是活动单元格下方的第1行和右侧的3列，如果活动单元格为D56，则表示它指的是G57。
ActiveCell（i，j）。Value
确实起作用，但它不是您想要使用的。例如，
ActiveCell（2，4）
指的是活动单元格下面的第1行，右边的第3列，如果活动单元格是D56，则表示它指的是G57。@peejayjay，你看明白了吗？是的，我试过了，它大大减少了我的代码行数！但我在这方面遇到的一个问题是，将大行（>30000）的数据写入文本文件时。计算速度太快了slow@peejayjay，你通过了吗？是的，我试过了，它大大减少了我的代码行数！但我在这方面遇到的一个问题是，将大行（>30000）的数据写入文本文件时。计算速度太慢了