Excel 用双引号封装输出

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

所有这些工作的代码。但是，输出文件需要在所有字段周围加引号，以便我们专有的GUI正确读取

e、 g.包含以下内容的行：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.")  

i=1到5的

对于j=1到40
cellHold=NewBook.Sheets（1）.单元格（j，i）.值
'NewBook.Sheets（1）.Cells（j，i）.NumberFormat=“@”
newCell=Chr（34）和cellHold&Chr（34）
NewBook.Sheets（1）.单元格（j，i）=newCell
下一个j
接下来我
如果是Dir（fPath和“OffsetCoordinates\u orig.csv”），则为Kill（fPath和“OffsetCoordinates\u orig.csv”）
wbOrig.SaveAs文件名：=fPath&“OffsetCoordinates\u orig.csv”，文件格式：=xlCSV
B开始，结束
如果是Dir（fPath&“OffsetCoordinates.csv”）”，则为Kill（fPath&“OffsetCoordinates.csv”）
NewBook.SaveAs文件名：=fPath&“OffsetCoordinates.csv”，文件格式：=xlCSV
纽布克，关门
MsgBox（“您的偏移量文件已成功更新。有关新文件，请参阅“&fPath&”）

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

“TestStrips1”、“1”、“1.2”、“0.6”、“0.4”

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

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

---

蒂姆指出的以下代码解决了大部分问题，其他答案看起来也很有用，但这是第一个解决问题的答案

    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

i=1到5的

对于j=1到40
cellHold=NewBook.Sheets（1）.单元格（j，i）.值
NewBook.Sheets（1）.Cells（j，i）.NumberFormat=“@”不是必需的吗？
newCell=cellHold
NewBook.Sheets（1）.单元格（j，i）=newCell
Debug.Print（NewBook.Sheets（1）.Cells（j，i）.Value）
下一个j
接下来我
如果是Dir（fpath和“OffsetCoordinates\u orig.csv”），则为Kill（fpath和“OffsetCoordinates\u orig.csv”）
wbOrig.SaveAs文件名：=fpath&“OffsetCoordinates\u orig.csv”，文件格式：=xlCSV
B开始，结束
如果是Dir（fpath&“OffsetCoordinates.csv”）”，则为Kill（fpath&“OffsetCoordinates.csv”）
'NewBook.SaveAs Filename:=fPath&'OffsetCoordinates.csv'，FileFormat:=xlCSV
Application.ActiveSheet.Range（“A1:E40”）。选择
调用QuoteCommand导出（fpath）
Application.DisplayAlerts=False
纽布克，关门
Application.DisplayAlerts=True
MsgBox（“您的偏移量文件已成功更新。有关新文件，请参阅“&fpath&”）
端接头
Sub QuoteCommand导出（fpath）
“来自微软解决方案的评论
'标注所有变量。
将文件设置为字符串
Dim FileNum作为整数
Dim ColumnCount为整数
将行计数设置为整数
'提示用户输入目标文件名。
DestFile=fpath&“OffsetCoordinates.csv”
'获取下一个可用文件句柄号。
FileNum=FreeFile（）
'关闭错误检查。
出错时继续下一步
'尝试打开目标文件以进行输出。
打开DestFile作为#FileNum输出
'如果发生错误，请报告并结束。
如果错误为0，则
MsgBox“无法打开文件名”&DestFile
终点
如果结束
'打开错误检查。
错误转到0
'循环选择中的每一行。
对于RowCount=1到40
'循环选择中的每列。
对于ColumnCount=1到5
'使用引号将当前单元格的文本写入文件。
打印#FileNum，“”和Selection.Cells（行数_
列计数）。文本（“”）；
'检查单元格是否在最后一列中。
如果ColumnCount=Selection.Columns.Count，则
'如果是，则写一个空行。
打印#FileNum，
其他的
否则，请写一个逗号。
打印#FileNum，“，”；
如果结束
'开始ColumnCount循环的下一次迭代。
下一列计数
'开始行计数循环的下一次迭代。
下一行计数
'关闭目标文件。
关闭#FileNum
端接头

---

微软提供的代码（见sub-QuoteCommaExport）基本上是按预期工作的，只是我有一种非常奇怪的行为，日期被错误地复制到输出的“csv”文件中。该单元格没有显示在源文件中，而是被复制为“#####”。我意识到，当我逐步阅读代码时，我有时会手动调整列的大小，使之与断点处的日期相匹配（以确保单元格中的日期正确，而不仅仅是一系列的#字符）。每当我这样做时，它都会正确地复制内容。因此，代码复制的是显示的字符，而不是单元格的内容。在调用Sub之前调整列的大小修复了该行为。

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

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

---

---

从Excel导出.CSV是一项棘手的工作。它导出的方式与您的本地化设置有着奇怪的联系。最初,，

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

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

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