用双引号封装输出
Encapsulating output in double quotes
我编写了一个接受 CSV 输入文件的宏，用硬编码调整更新一些字段，然后再次将文件另存为 CSV。
所有这些的代码都有效。但是，输出文件需要在所有字段周围加上引号才能被我们专有的 GUI 正确读取。
例如一行包含：TestStrips1, 1, 0.8, 0, -0.2
需要格式化为："TestStrips1", "1", "0.8", "0", "-0.2"
这是我的代码中与此相关的部分。使用硬编码 row/col 数字，因为它们不会改变。 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.")
无论是否将数字格式设置为字符串，我都试过了，它似乎不影响输出。令人困惑的是，这段代码产生的输出在 Excel 中查看时实际上看起来是正确的（每个单元格周围的引号），但是当使用记事本++查看时，实际上每个项目周围都有三重引号，如下所示：
""""TestStrips1""","""1""","""-1.2""","""0.6""","""0.4""""
当我查看我试图模拟的父文件时，在 Excel 中查看时，单元格中没有引号，但在记事本++中，输出符合预期，每个项目都带有引号。
我不清楚这是格式问题，还是 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 之前调整列的大小修复了行为。
您可以使用 Powershell 在数字周围添加引号。
- 如果要覆盖文件需要关闭文件
- 该文件必须有一个 header 行用于此解决方案
- 打开文件并从 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
从 Excel 导出 .CSV 是一项棘手的工作。它的导出方式奇怪地与您的本地化设置相关联。最初，我试图重现您的情况，但我做不到。一切都按预期导出（我的意思是用简单的引号）。然后，弄乱 'Region' 本地化（附加设置：列表分隔符、小数符号、数字分组符号）我可以重现你所指的行为。之后，我无法回到我的初始设置......
因此，我试图找到一种不同的可靠方式来创建 .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 全名。
当然，可以改进代码以自动确定要导出的范围，如果不是您示例中的所有时间...
你也可以使用正则表达式：
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\test.csv") 'Reading
s = re.Replace(txt.ReadAll(), """""")
txt.Close
Set txt = fso.OpenTextFile("C:\Temp\test.csv", 2) 'Updating
txt.Write s: txt.Close
End Sub
我编写了一个接受 CSV 输入文件的宏，用硬编码调整更新一些字段，然后再次将文件另存为 CSV。
所有这些的代码都有效。但是，输出文件需要在所有字段周围加上引号才能被我们专有的 GUI 正确读取。
例如一行包含：TestStrips1, 1, 0.8, 0, -0.2
需要格式化为："TestStrips1", "1", "0.8", "0", "-0.2"
这是我的代码中与此相关的部分。使用硬编码 row/col 数字，因为它们不会改变。 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.")
无论是否将数字格式设置为字符串，我都试过了，它似乎不影响输出。令人困惑的是，这段代码产生的输出在 Excel 中查看时实际上看起来是正确的（每个单元格周围的引号），但是当使用记事本++查看时，实际上每个项目周围都有三重引号，如下所示：
""""TestStrips1""","""1""","""-1.2""","""0.6""","""0.4""""
当我查看我试图模拟的父文件时，在 Excel 中查看时，单元格中没有引号，但在记事本++中，输出符合预期，每个项目都带有引号。
我不清楚这是格式问题，还是 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 之前调整列的大小修复了行为。
您可以使用 Powershell 在数字周围添加引号。
- 如果要覆盖文件需要关闭文件
- 该文件必须有一个 header 行用于此解决方案
- 打开文件并从 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
从 Excel 导出 .CSV 是一项棘手的工作。它的导出方式奇怪地与您的本地化设置相关联。最初，我试图重现您的情况，但我做不到。一切都按预期导出（我的意思是用简单的引号）。然后，弄乱 'Region' 本地化（附加设置：列表分隔符、小数符号、数字分组符号）我可以重现你所指的行为。之后，我无法回到我的初始设置...... 因此，我试图找到一种不同的可靠方式来创建 .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 全名。
当然，可以改进代码以自动确定要导出的范围，如果不是您示例中的所有时间...
你也可以使用正则表达式：
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\test.csv") 'Reading
s = re.Replace(txt.ReadAll(), """""")
txt.Close
Set txt = fso.OpenTextFile("C:\Temp\test.csv", 2) 'Updating
txt.Write s: txt.Close
End Sub