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 

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

 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（我，j）。价值不起作用，但我不知道如何纠正这个问题。 我正在使用Excel 2010

Answer 1

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

• 数组及其切片方法

• 实时化FileSystemObject文件对象“即时”

如下所示：

 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 

Answer 2

您需要将ActiveCell(i, j)replace为Cells(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