用双引号封装输出

Question

我编写了一个宏，它接受 CSV 输入文件，使用硬编码调整更新一些字段，然后将文件再次保存为 CSV。

所有这些工作的代码。但是，输出文件需要包含所有字段的引号才能被我们专有的 GUI 正确读取。

例如一行包含：TestStrips1, 1, 0.8, 0, -0.2

需要格式化为：“TestStrips1”、“1”、“0.8”、“0”、“-0.2”

这是我的代码中与使这种情况有关的部分。使用硬编码的行/列号，因为它们不会改变。 cellHold 和 newCell 作为上述变体是 DIMd，我将它们用作使串联按预期工作的一种方式：

For i = 1 To 5
    For j = 1 To 40
        cellHold = NewBook.Sheets(1).Cells(j, i).Value
        'NewBook.Sheets(1).Cells(j, i).NumberFormat = "@"
        newCell = Chr(34) & cellHold & Chr(34)
        NewBook.Sheets(1).Cells(j, i) = newCell
    Next j
Next i
If Dir(fPath & "OffsetCoordinates_orig.csv") <> "" Then Kill (fPath & "OffsetCoordinates_orig.csv")
wbOrig.SaveAs Filename:=fPath & "OffsetCoordinates_orig.csv", FileFormat:=xlCSV
wbOrig.Close
If Dir(fPath & "OffsetCoordinates.csv") <> "" Then Kill (fPath & "OffsetCoordinates.csv")
NewBook.SaveAs Filename:=fPath & "OffsetCoordinates.csv", FileFormat:=xlCSV
NewBook.Close
MsgBox ("Your Offset file has been updated successfully. Please see " & fPath & " for your new file.")  

我已经尝试过，无论是否将 numberformat 设置为 string，它似乎都不会影响输出。令人困惑的是，这段代码产生的输出在 Excel 中查看时看起来实际上是正确的（每个单元格周围都有引号），但是当使用 notepad++ 查看时，实际上每个项目周围都有三重引号，如下所示：

"""TestStrips1""","""1""","""-1.2""","""0.6""","""0.4"""

当我查看我试图模拟的父文件时，在 Excel 中查看时，单元格中没有引号，但在 notepad++ 中，输出与预期的一样，每个项目都带有引号。

我不清楚这是否是格式问题，或者 Excel 是否添加了额外的引号字符。

---

大部分是用 Tim 指出的以下代码解决的，其他答案看起来也很有用，但这首先完成了。

    For i = 1 To 5
        For j = 1 To 40
            cellHold = NewBook.Sheets(1).Cells(j, i).Value
            NewBook.Sheets(1).Cells(j, i).NumberFormat = "@" 'not necessary?
            newCell = cellHold
            NewBook.Sheets(1).Cells(j, i) = newCell
            Debug.Print (NewBook.Sheets(1).Cells(j, i).Value)
        Next j
    Next i
    If Dir(fpath & "OffsetCoordinates_orig.csv") <> "" Then Kill (fpath & "OffsetCoordinates_orig.csv")
    wbOrig.SaveAs Filename:=fpath & "OffsetCoordinates_orig.csv", FileFormat:=xlCSV
    wbOrig.Close
    If Dir(fpath & "OffsetCoordinates.csv") <> "" Then Kill (fpath & "OffsetCoordinates.csv")
'    NewBook.SaveAs Filename:=fPath & "OffsetCoordinates.csv", FileFormat:=xlCSV
    Application.ActiveSheet.Range("A1:E40").Select
    Call QuoteCommaExport(fpath)
    Application.DisplayAlerts = False
    NewBook.Close
    Application.DisplayAlerts = True
    MsgBox ("Your Offset file has been updated successfully. Please see " & fpath & " for your new file.")
End Sub

Sub QuoteCommaExport(fpath)
'Comments from Microsoft's solution 
' Dimension all variables. 
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer

    ' Prompt user for destination file name.
    DestFile = fpath & "OffsetCoordinates.csv"

    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next

    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum

    ' If an error occurs report it and end.
    If Err <> 0 Then
        MsgBox "Cannot open filename " & DestFile
        End
    End If

    ' Turn error checking on.
    On Error GoTo 0

    ' Loop for each row in selection.
    For RowCount = 1 To 40

        ' Loop for each column in selection.
        For ColumnCount = 1 To 5

            ' Write current cell's text to file with quotation marks.
            Print #FileNum, """" & Selection.Cells(RowCount, _
              ColumnCount).Text & """";

            ' Check if cell is in last column.
            If ColumnCount = Selection.Columns.Count Then
                ' If so, then write a blank line.
                Print #FileNum,
            Else
                ' Otherwise, write a comma.
                Print #FileNum, ",";
            End If
        ' Start next iteration of ColumnCount loop.
        Next ColumnCount
    ' Start next iteration of RowCount loop.
    Next RowCount

    ' Close destination file.
    Close #FileNum
End Sub

Microsoft 提供的代码（在子 QuoteCommaExport 中看到）大部分都按预期工作，除了我遇到了非常奇怪的行为，即日期被错误地复制到输出“csv”文件中。该单元格没有像在源文件中那样显示，而是被复制为“#######”。我意识到，当我单步执行代码时，我有时会手动调整列的大小以适应断点（以确保正确的日期在单元格中，而不仅仅是一系列 # 字符）。每当我这样做时，它都会正确复制内容。所以代码是复制显示的字符而不是单元格的内容。在调用 Sub 之前调整列的大小修复了该行为。

Answer 1

您可以使用 Powershell 在数字周围添加引号。

• 如果要覆盖该文件，需要将其关闭
• 文件必须有此解决方案的标题行
• 打开文件并从 Excel 中保存将删除双引号

---

Sub AddQuotesToCSV(ByVal FileName As String, Optional ByVal NewFileName As String)
    Const PowershellCommand As String = "Powershell " & vbNewLine & _
        "$P = Import-Csv -Path '@FileName'" & vbNewLine & _
        "$P | Export-Csv -Path '@NewFileName' -NoTypeInformation -Encoding UTF8"
    Dim Command As String

    Command = Replace(PowershellCommand, "@FileName", FileName)
    Command = Replace(Command, "@NewFileName", IIf(Len(NewFileName) > 0, NewFileName, FileName))

    CreateObject("WScript.Shell").Exec Command
End Sub

Answer 2

从 Excel 导出 .CSV 是一项棘手的工作。它的导出方式奇怪地与您的本地化设置相关联。最初，我试图重现您的情况，但我不能。一切都按预期导出（我的意思是简单的引号）。然后，弄乱“区域”本地化（附加设置：列表分隔符、小数符号、数字分组符号），我可以重现您所指的行为。之后，我无法回到我的初始设置... 因此，我试图找到另一种可靠的 .CSV 文件创建方式。我很快，因为一切都在内存中完成：

Dim arr As Variant, arr1() As Variant, i As Long, j As Long, sh As Worksheet
  Set sh = NewBook.Sheets(1)
  'Add quotes and input the necessary range in an array
  arr = sh.Range("A1:E40").value
  ReDim arr1(4, UBound(arr))
  For i = 1 To UBound(arr)
     For j = 0 To 4
        arr1(j, i - 1) = Chr(34) & arr(i, j + 1) & Chr(34)
     Next
  Next i
  'create .CSV comma delimited
  Dim newF As String, FileNum, strRow As String
  newF = "C:\YourFile.csv"
  FileNum = FreeFile()
  Open newF For Output As #FileNum
    For i = 0 To UBound(arr) - 1
        strRow = arr1(0, i) & "," & arr1(1, i) & "," & arr1(2, i) & _
                                        arr1(3, i) & "," & arr1(4, i)
        Print #FileNum, strRow
    Next i
  Close #FileNum

对于您的（示例）范围，它几乎可以立即运行... 请注意将 newF 变量更改为您真正需要的 .CSV 全名。 当然，可以改进代码以自动确定要导出的范围，如果不是所有时间都来自您的示例...

Answer 3

你也可以使用正则表达式：

Sub FF()
    Dim s, re, fso, txt
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True: re.Pattern = "([^,$\r\n]+)"
    Set txt = fso.OpenTextFile("C:\Temp\1\test.csv") 'Reading
    s = re.Replace(txt.ReadAll(), """$1""")
    txt.Close
    Set txt = fso.OpenTextFile("C:\Temp\1\test.csv", 2) 'Updating
    txt.Write s: txt.Close
End Sub