Question

我编写了以下代码，目的是将两个范围保存到一个 CSV 文件中：

Sub Export_range_to_CSV()
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim range1 As Range
    Dim range2 As Range
    Set range1 = Sheets("sheet1").Range("G2:G4")
    Set range2 = Sheets("sheet1").Range("G5:H53")

    Application.DisplayAlerts = False
    On Error GoTo err

    Set myWB = ThisWorkbook
    myCSVFileName = "filepath" & "\" & "name" & VBA.Format(VBA.Now, "yyyymmdd_hhmm") & ".csv"
    
    range1.Copy

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        range2.Copy
        .Sheets(1).Range("A4").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With
err:
    Application.DisplayAlerts = True
End Sub

上面的代码完成了这项工作，但是对于 range1，当保存为 CSV 时，它在字符串的末尾有逗号。我需要删除这些才能让下游的工作正常工作。如何去掉 range1 末尾的逗号？

这是保存为 CSV 文件后的样子：

范围1

- # X=Y, <- need to remove these commas
- # Z=U,
- # M=Q,

范围2

- datetime,quantity
- 2021-03-05 23:00:00+00:00,17
- 2021-03-05 23:30:00+00:00,17
- 2021-03-06 00:00:00+00:00,17
- 2021-03-06 00:30:00+00:00,17

我认为问题出在 range1 只有一列，一旦 range2 发挥作用，它就会假设 range1 也应该是两列。

Answer 1

最后一列是通过检查两个范围的最后一列来计算的。以较高者为准。让我解释一下。

假设数据直到列 J

Set range1 = Sheets("sheet1").Range("G2:G4")
Set range2 = Sheets("sheet1").Range("G5:J53")

那么在这种情况下，将添加 3 个逗号。同样，如果最后一列是 range2 中的 K，最后一列是 H 中的 range1，那么第一个范围将添加 3 个逗号。

当你反转范围时同样适用

Set range1 = Sheets("sheet1").Range("G5:J53")
Set range2 = Sheets("sheet1").Range("G2:G4")

现在第二个范围会有额外的逗号

解决方案

读取数组中的数据，然后删除最后一个逗号。所以一旦你的 Csv 文件被写入，把文件传递给这个过程，它会处理剩下的

以下代码一次性读取数组中的 csv，然后检查每一行是否有 , 右侧。如果有，则将其删除。最后它删除旧的 csv 并通过一次性将数组放入文本文件来写入新文件。我已经对代码进行了注释，因此您理解它应该不会有问题。但如果你这样做了，那就简单地问一下。

'~~> Example usage
Sub Sample()
    CleanCsv "C:\Users\Siddharth Rout\Desktop\aaa.txt"
End Sub

'~~> Cleans csv
Sub CleanCsv(fl As String)
    Dim MyData As String, strData() As String
    Dim i As Long
    
    '~~> Read the file in one go into an array
    Open fl For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
    
    '~~> Check for "," and remove
    For i = LBound(strData) To UBound(strData)
        If Right(strData(i), 1) = "," Then
            Do While Right(strData(i), 1) = ","
                strData(i) = Left(strData(i), Len(strData(i)) - 1)
            Loop
        End If
    Next i
    
    '~~> Kill old file
    Kill fl
    
    '~~> Output the array in one go into a text file
    Dim ff As Long
    ff = FreeFile
    Open fl For Binary As #ff
    
    Put #ff, , Join(strData, vbCrLf)
    
    Close #ff
End Sub

Answer 2

删除尾随逗号

您运行 exportRangesToCSV，而 removeTrailingCommaInTextFile 正在接近尾声被调用，而 removeTrailingComma 正在被 removeTrailingCommaInTextFile 调用。
我对其进行了测试并且可以正常工作，但请记住，我对操作文本文件（第二个过程）知之甚少，这或多或少是我编写的第一个正则表达式（第三个过程）。我花了“很长时间”来写它们（不是抱怨）。第一个程序是我“在家”的地方。
请注意第二个过程中经典错误处理例程的示例（您的示例是不可接受的：您错过了 Resume 部分）。您可以轻松地将其应用于第一个程序。
不要忘记调整常量部分中的值。

代码

Option Explicit

Sub exportRangesToCSV()
    
    Const sName As String = "Sheet1"
    Const sAddr As String = "G2:G4,G5:H53"
    
    Const dFolderPath As String = "C:\Test"
    Const dLeftBaseName As String = "Name"
    Const dTimeFormat As String = "yyyymmdd_hhmm"
    Const dFileExtension As String = ".csv"
    Const dAddr As String = "A1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rg As Range: Set rg = wb.Worksheets(sName).Range(sAddr)
    
    Dim dFilePath As String
    dFilePath = dFolderPath & "\" & dLeftBaseName _
        & VBA.Format(VBA.Now, dTimeFormat) & dFileExtension
    
    Application.ScreenUpdating = False
    With Workbooks.Add()
        Dim dCell As Range: Set dCell = .Worksheets(1).Range(dAddr)
        Dim srg As Range
        For Each srg In rg.Areas
            dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
            Set dCell = dCell.Offset(srg.Rows.Count)
        Next srg
        Application.DisplayAlerts = False
        .SaveAs dFilePath, xlCSV
        Application.DisplayAlerts = True
        .Close False
    End With
    Application.ScreenUpdating = True
    
    removeTrailingCommaInTextFile dFilePath, True
    
    'wb.FollowHyperlink dFolderPath

End Sub

Sub removeTrailingCommaInTextFile( _
        ByVal FilePath As String, _
        Optional ByVal removeAllOccurrences As Boolean = False)
    Const ProcName As String = "removeTrailingCommaInTextFile"
    On Error GoTo clearError

    Dim TextFile As Long: TextFile = FreeFile
    Dim TempString As String
    Open FilePath For Input As TextFile
    TempString = Input(LOF(TextFile), TextFile)
    Close TextFile
    Open FilePath For Output As TextFile
    Print #TextFile, removeTrailingComma(TempString, removeAllOccurrences)
    Close TextFile

ProcExit:
    Exit Sub
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & err.Number & "':" & vbLf _
              & "        " & err.Description
    Resume ProcExit
End Sub

Function removeTrailingComma( _
    ByVal SearchString As String, _
    Optional ByVal removeAllOccurrences As Boolean = False) _
As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        If removeAllOccurrences Then
            .Pattern = ",+$"
        Else
            .Pattern = ",$"
        End If
        removeTrailingComma = .Replace(SearchString, "")
    End With
End Function

编辑

此解决方案将直接写入文本文件而不导出。如果单元格太多，它可能会变慢。

数组

Sub exportRangesToCSVArrays()
    
    Const sName As String = "Sheet1"
    Const sAddr As String = "G2:G4,G5:H53"
    
    Const dFolderPath As String = "C:\Test"
    Const dLeftBaseName As String = "Name"
    Const dTimeFormat As String = "yyyymmdd_hhmm"
    Const dFileExtension As String = ".csv"
    Const dAddr As String = "A1"
    Const Delimiter As String = ","
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rg As Range: Set rg = wb.Worksheets(sName).Range(sAddr)
    
    Dim aCount As Long: aCount = rg.Areas.Count
    Dim Data As Variant: ReDim Data(1 To aCount)
    Dim rData() As Long: ReDim rData(1 To aCount)
    Dim cData() As Long: ReDim cData(1 To aCount)
    Dim OneCell As Variant: ReDim OneCell(1 To 1, 1 To 1)
    Dim srg As Range
    Dim srCount As Long, scCount As Long
    Dim drCount As Long, dcCount As Long
    Dim n As Long
    
    For Each srg In rg.Areas
        n = n + 1
        srCount = srg.Rows.Count: scCount = srg.Columns.Count
        rData(n) = srCount: cData(n) = scCount
        If srCount > 1 Or scCount > 1 Then
            Data(n) = srg.Value
        Else
            Data(n) = OneCell: Data(1, 1) = srg.Value
        End If
        drCount = drCount + srCount
        If scCount > dcCount Then
            dcCount = scCount
        End If
    Next srg
    
    Dim Result() As String: ReDim Result(1 To drCount)
    Dim r As Long, i As Long, j As Long
    For n = 1 To aCount
        For i = 1 To rData(n)
            r = r + 1
            For j = 1 To cData(n)
                Result(r) = Result(r) & CStr(Data(n)(i, j)) & Delimiter
            Next j
            Result(r) = removeTrailingComma(Result(r), True)
        Next i
    Next n
    
    Dim dFilePath As String
    dFilePath = dFolderPath & "\" & dLeftBaseName _
        & VBA.Format(VBA.Now, dTimeFormat) & dFileExtension
    
    Dim TextFile As Long: TextFile = FreeFile
    Dim TempString As String
    Open dFilePath For Output As TextFile
    Print #TextFile, Join(Result, vbLf)
    Close TextFile

    'wb.FollowHyperlink dFolderPath

End Sub

如何去除 CSV 文件中字符串末尾不需要的逗号

2 个答案:

删除尾随逗号