Question

我有一个现有的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）.Value不起作用，但我不知道如何纠正这个问题。我正在使用Excel 2010

Answer 1

您可以通过以下方式大大减少代码的长度：

数组和their slicing methods
动态实例化FileSystemObject文件对象＆＃34;

如下：

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)替换为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

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

2 个答案: