使用 VBA 从最近转换的 .csv 文件中删除多余的逗号行-解网

问：

我目前从源系统中提取一个文件，并得到一个 .csv 文件。我的过程要求我将此 .csv 保存为 .txt 文件，以便可以将其上传到另一个系统。

我已经编写了VBA代码，该代码会自动为.csv文件列表执行此操作。

但是，.txt 文件在数据下方有很多空行（用逗号表示）。我已经检查过了，它不是真实数据，即这里没有空格。我假设它是一种元数据。但它给我带来了问题，因为我需要在上传之前删除所有底部逗号。

以下是从 .csv 转换后的 .txt 文件的示例：

File name,dim1,blank,dim2
file 1,1,,apple
file 1,2,,orange
file 1,3,,banana
,,
,,
,,
,,

我需要它看起来像这样：

File name,dim1,blank,dim2
file 1,1,,apple
file 1,2,,orange
file 1,3,,banana

我知道这里的答案。但这并不能解决问题，因为我没有逗号，而是数据下方的空白区域，因此不能用作上传。

    fn = Application.GetOpenFilename(FolderPath & FileName & ".txt")
    If fn = "" Then Exit Sub
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = ",+$"
        Open Replace(fn, ".txt", "_Clean.txt") For Output As #1
            Print #1, .Replace(txt, "")
        Close #1
    End With

最终结果将如下所示，这是不合适的：

File name,dim1,blank,dim2
file 1,1,,apple
file 1,2,,orange
file 1,3,,banana

以下是从源 .csv 文件创建 .txt 文件的代码。我不受这种方法的束缚，如果它删除了逗号，我很乐意改变

Sub CreateTextFiles()
Application.ScreenUpdating = False

Dim rng As Range
Set rng = Range("A1:A4")
Dim FileName As String
Dim FolderPath As String
FolderPath = Range("C1").Value

For Each cell In rng
    FileName = cell.Value
    'THIS WORKS BUT THE COMMAS ARE STILL PRESENT
    FileCopy FolderPath & FileName & ".csv", FolderPath & FileName & ".txt"
    
    'OPENS A NOTEPAD
    'Shell "notepad.exe " & FolderPath & FileName & ".csv", vbNormalFocus
Next cell

Application.ScreenUpdating = True
MsgBox "Text files have been created"
End Sub

Excel VBA CSV 发送

Sub CreateTextFiles()
    Application.ScreenUpdating = False
    
    Dim rng As Range
    Set rng = Range("A1:A4")
    Dim FileName As String
    Dim FolderPath As String
    Dim LastRow As Long
    Dim ws As Worksheet
    FolderPath = Range("C1").Value
    
    For Each cell In rng
        FileName = cell.Value
        Set ws = Workbooks.Open(FolderPath & FileName & ".csv").Sheets(1)
        
        For LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If Trim(ws.Cells(LastRow, 1).Value) <> "" Then
                Exit For
            End If
        Next LastRow
        
        'Delete all rows below the last non-empty row
        If LastRow < ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Then
            ws.Rows(LastRow + 1 & ":" & ws.Rows.Count).Delete
        End If
        
        ws.SaveAs FolderPath & FileName & ".txt", FileFormat:=xlText
        ws.Parent.Close
        
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox "Text files have been created"
End Sub

3赞 CDP1802 10/20/2023 #2

Sub CSVtoTXT()

    ' select csv file
    Dim csvFile As String, txtFile As String
    Dim fso, tsIn, tsOut, s As String, n As Long, i As Long
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ""
        .AllowMultiSelect = False
        .Filters.Add "csv", "*.csv"
        .Title = "Select csv"
        
        If .Show = False Then
            MsgBox "File not selected to import."
            Exit Sub
        End If
        csvFile = .SelectedItems(1)
        txtFile = Replace(csvFile, ".csv", ".txt")
    End With
    
    ' remove `` lines
    Set fso = CreateObject("Scripting.FilesystemObject")
    Set tsOut = fso.createtextfile(txtFile)
    Set tsIn = fso.opentextfile(csvFile)
    With tsIn
        Do While .AtEndOfStream = False
           s = .readline
           If Left(s, 1) <> "," Then
               n = n + 1
               If n > 1 Then s = vbCrLf & s
               tsOut.write s
           End If
           i = i + 1
        Loop
    End With
    
    ' result
    MsgBox i & " lines read from " & csvFile & vbLf & _
           n & " lines written to " & txtFile, vbInformation

只是想感谢您的解决方案。虽然我使用了上面的答案，但这已经过测试并且也有效。我意识到的最后一个要求是生成的文本文件不能在数据下方有一行。从字面上看，它只需要一个退格键就可以保存了。这是一个很小的细节，但我的导入将不起作用。我尝试过 Selection.TypeBackspace 和 SendKeys （“{BACKSPACE}”）但我无法让它正常工作。有什么解决办法吗？

1赞 CDP1802 11/14/2023

@JackPennington OK 查看更新

3赞 Tim Williams 10/20/2023 #3

编辑：从最后一个输出行中删除了尾随换行符。

这是您可以做到的一种方法：

Sub Tester()

    ProcessCSV "C:\Temp\Test.csv"

End Sub

Sub ProcessCSV(f As String)
    Dim fso As Object, strmIn As Object, strmOut As Object, l As String
    Dim col As New Collection, i As Long
    Set fso = CreateObject("scripting.filesystemobject")
    
    'open input and output streams
    Set strmIn = fso.OpenTextFile(Filename:=f, IOMode:=1)
    Do While Not strmIn.AtEndOfStream 'loop through the input file lines
        l = strmIn.ReadLine
        If Len(Replace(l, ",", "")) > 0 Then col.Add l 'save line if not just commas
    Loop
    strmIn.Close   'close stream
    
    Set strmOut = fso.OpenTextFile(Filename:=Replace(f, ".csv", "_clean.txt", Compare:=vbTextCompare), _
                                   IOMode:=2, Create:=True)
    For i = 1 To col.Count - 1
        strmOut.WriteLine col(i)  'write all lines except last
    Next i
    strmOut.Write col(col.Count)  'last line with no newline
    strmOut.Close                 'close stream
End Sub

谢谢你的回答是有效的。我意识到的另一个要求是生成的文本文件不能在数据下方有一行。从字面上看，它只需要一个退格键就可以保存了。这是一个很小的细节，但我的导入将不起作用。我已经尝试过了，但我无法让它正常工作。有什么想法吗？Selection.TypeBackspaceSendKeys ("{BACKSPACE}")

1赞 Tim Williams 11/15/2023

上面更新的代码...

0赞 taller 10/20/2023 #4

更新模式并消除尾随回车RegExp
修改后的代码标记为 w/ **

    fn = Application.GetOpenFilename(FolderPath & Filename & ".txt")
    If fn = "" Then Exit Sub
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "^,+$\s*"  ' **
        Dim sNewTxt As String  ' **
        Open Replace(fn, ".txt", "_Clean.txt") For Output As #1
        sNewTxt = .Replace(txt, "") ' **
        sNewTxt = Left(sNewTxt, Len(sNewTxt) - 2) ' **
        Print #1, sNewTxt ' **
        Close #1
    End With

上一个：需要帮助从 VBA 翻译成 C# 硒

下一个：VBA 打开带有记事本的 .csv 文件，另存为 .txt

使用 VBA 从最近转换的 .csv 文件中删除多余的逗号行

Using VBA to remove excess comma rows from a recently converted .csv file

评论

评论

评论