Question

我正在将电子表格中的数据保存到文本文件中，每次打开它时，最后一个数据后都会有一个空白行，我需要将其保留为最后一个值。因此，我需要重新打开文本文件并从文本文件中击退空格，然后重新保存它。我正在寻找vba，以便在保存时自动执行此操作。

现在，我已经进行了一些研究并测试了它们，但是它们都没有起作用。意味着他们不会删除空白行。当我执行当前代码时，保存部分起作用，而行删除部分则不起作用。没有任何反应，没有错误，并且不会删除空白行。我已经包含了我需要vba进行操作的图片，请注意需要将光标放在哪里。我也希望能在1个模块中实现空白行的保存和删除。

Sub Rectangle1_Click()
Dim strTemplateFile As String
Dim strFname As String
Dim strFnameClean As String
Dim FileSaveName

Application.DisplayAlerts = False
' Save file name and path into a variable
strTemplateFile = ActiveWorkbook.FullName

' Default directory would be c:\temp.  Users however will have the ability
' to change where to save the file if need be.

FileSaveName = Application.GetSaveAsFilename( _
               InitialFileName:="C:\Users\SC1324\Desktop\test.txt", _
               fileFilter:="Text Files (*.txt), *.txt")

If FileSaveName = False Then
    Exit Sub
End If

' Save file as .txt TAB delimited fileSaveName, FileFormat:=36,
ActiveWorkbook.SaveAs Filename:= _
                      FileSaveName, FileFormat:=xlTextWindows, _
                      CreateBackup:=False

strFname = ActiveWorkbook.FullName
strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
Call Test(strFname, strFnameClean)
End Sub


Sub Test(ByVal strFname, ByVal strFnameClean)
Const ForReading = 1
Const ForWriting = 2

Dim objFSO As Object
Dim objTF As Object
Dim strAll As String
Dim varTxt
Dim lngRow As Long
iNumberOfLinesToDelete = 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(strFname, ForReading)
strAll = objTF.ReadAll
objTF.Close
Set objTF = objFSO.createTextFile(strFnameClean, ForWriting)
objTF.write Mid(strAll, 1, Len(strAll) - 2)
objTF.Close
End Sub

Answer 1

Sub Rectangle1_Click()
Dim strTemplateFile As String
Dim strFname As String
Dim strFnameClean As String
Dim FileSaveName

Application.DisplayAlerts = False
' Save file name and path into a variable
strTemplateFile = ActiveWorkbook.FullName

' Default directory would be c:\temp.  Users however will have the ability
' to change where to save the file if need be.

FileSaveName = Application.GetSaveAsFilename( _
               InitialFileName:="C:\Users\sc1324\Desktop\test.txt", _
               fileFilter:="Text Files (*.txt), *.txt")

If FileSaveName = False Then
    Exit Sub
End If

' Save file as .txt TAB delimited fileSaveName, FileFormat:=36,
ActiveWorkbook.SaveAs Filename:= _
                      FileSaveName, FileFormat:=xlTextWindows, _
                      CreateBackup:=False

strFname = ActiveWorkbook.FullName
strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
Call Test(strFname, strFnameClean)
End Sub


Sub Test(ByVal strFname, ByVal strFnameClean)
Const ForReading = 1
Const ForWriting = 2

Dim objFSO As Object
Dim objTF As Object
Dim strAll As String
Dim varTxt
Dim lngRow As Long
iNumberOfLinesToDelete = 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(strFname, ForReading)
strAll = objTF.ReadAll
objTF.Close
Set objTF = objFSO.createTextFile(strFnameClean, ForWriting)
objTF.write Mid(strAll, 1, Len(strAll) - 2)
objTF.Close
End Sub

Answer 2

真的不确定为什么要一次写每一行...

Const FOR_READING = 1
Const FOR_WRITING = 2
strFileName = "C:\Users\sc1324\Desktop\test.txt"
iNumberOfLinesToDelete = 1

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strFileName, FOR_READING)
strContents = objTS.ReadAll
objTS.Close

Set objTS = objFS.OpenTextFile(strFileName, FOR_WRITING)
objTS.write mid(strContents,1,len(strContents)-2)
objTS.Close

足够吗？

也请注意WriteLine ...的文档

将指定的字符串和换行符写入TextStream文件

所以您将要使用write()

编辑：

如果我是你，我将执行以下操作：

sub backupSheet(sht as worksheet, ByVal path as string)
   Dim v as variant
   v=sht.UsedRange.Value.
   Dim i,j as integer, s as string
   For i = lbound(v,1) to ubound(v,1)
      For j = lbound(v,2) to ubound(v,2)
         s = s & v(i,j) & ","
      Next j
      s = mid(s,1,len(s)-1) & vbCrLf
   Next i
   s = mid(s,1,len(s)-2)
   Set objFS = CreateObject("Scripting.FileSystemObject")
   Set objTS = objFS.OpenTextFile(path, 2)
   objTS.write(s)
   objTS.close
end sub
sub test()
   Dim ws as worksheet
   for each ws in ThisWorkbook.sheets
      backupSheet ws, ThisWorkbook.path & "\test_" & ws.name & ".csv"
   next
end sub

或类似的东西

从文本文件vba删除最后一行

2 个答案: