时间戳

首页 > 解决方案 > 将excel数据提取到文本文件

excel - 将excel数据提取到文本文件

问题描述

我有一个excel文件，其数据从左到右。我想将它从上到下复制到记事本中。让我解释。如excel表格图片所示，excel表格分为图层，图层0，图层1等。 在此处输入图像描述 我希望 vba 代码将所有数据从第一列（第 0 层）复制到第 5 列到记事本中。然后再次从第 6 列（第 1 层，红色边界）开始复制数据，直到该层在新行的末尾。手术一直在进行。这样它就会产生这样的结果。这是我尝试过的 在此处输入图像描述

Sub SaveAsTxtFile()
Dim FileName As String
Dim SLine As String
Dim Deliminator As String
Dim Lastcol, LastRow, FileNumber As Integer
'Locationand File Name
FileName = "/Users/random/Desktop/G_code.Path.txt"

Deliminator = " "
Lastcol = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Column
LastRow = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
FileNumber = FreeFile

'creating or Overwritting a text file
Open FileName For Output As FileNumber

'Reading the datafrom the excel
For i = 1 To LastRow
    For j = 1 To Lastcol
        If j = Lastcol Then
            SLine = SLine & Cells(i, j).Value
        Else
            SLine = SLine & Cells(i, j).Value & Deliminator
        End If
    Next j
    'Writing data in test file
    Print #FileNumber, SLine
    SLine = ""
Next i
Close #FileNumber
MsgBox "Text file has been generated"

End Sub

但是这样的结果在记事本中是从左到右而不是从上到下读取的。我认为关键是检测单元格中是否有关键字“LAYER”，如果是这样，那么它知道它应该开始打印到记事本中的下一行（在前一行之下）。 在此处输入图像描述

标签： excelvba

解决方案

尝试，

Sub ExportSheetsToTxt()

    Dim Ws As Worksheet
    Dim FileName As String
    Dim rngDB As Range
    Dim r As Long, c As Integer
    Dim i As Long
    Dim myString As String
    
    Set Ws = Sheets(1)
        'FileName = CurDir & "\" & Ws.Name & ".txt"
        FileName = "/Users/random/Desktop/G_code.Path.txt"
        With Ws
            r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            For i = 1 To c Step 6
                Set rngDB = .Cells(5, i).Resize(r - 4, 6)
                myString = myString & getString(rngDB)
            Next i
     End With
     TransToTxt Filename, myString
    MsgBox ("Files Saved Successfully")
End Sub
Function getString(rng As Range)
    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim strTxt As String
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR)
    Next i
    strTxt = Join(vTxt, vbCrLf) & vbCrLf & vbCrLf
    getString = strTxt
End Function
Sub TransToTxt(myfile As String, strTxt As String)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing
End Sub

推荐阅读