Excel 2010 – 将格式化数字写入CSV的VBA代码
我正在处理一个5工作表，其中工作表5上名为ExportCSV的buttonExportCSV工作表3上的数据。更具体地说，该button将运行一个VBA代码逐行进行并检查前3个单元的数据。 如果前三个单元格中的任何一个有数据，则select整行。 在select了所有包含数据的行之后，将数据逐行写入CSV文件（但文件本身是以分号分隔的）。
我遇到的问题是某些单元格格式正在被复制，但有些却不是。 例如，格式为$ Accounting的单元格中的值格式正确，意思是“$ 12,345,678.90”显示为“$ 12,345,678.90”。 但是，格式为“会计”但没有$的单元格中的值没有正确写入csv，这意味着“12,345,678.90”正在写为“12345678.9”。
下面是有问题的macros。
Dim planSheet As Worksheet Dim temSheet As Worksheet Private Sub ExportCSV_Click() Dim i As Integer Dim j As Integer Dim lColumn As Long Dim intResult As Integer Dim strPath As String On Error GoTo Errhandler Set temSheet = Worksheets(3) i = 2 Do While i < 1001 j = 1 Do While j < 4 If Not IsEmpty(temSheet.Cells(i, j)) Then temSheet.Select lColumn = temSheet.Cells(2, Columns.Count).End(xlToLeft).Column temSheet.Range(temSheet.Cells(2, 1), temSheet.Cells(i, lColumn)).Select End If j = j + 1 Loop i = i + 1 Loop Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = Application.ActiveWorkbook.Path Application.FileDialog(msoFileDialogFolderPicker).Title = "Select a Path" Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Select Path" intResult = Application.FileDialog(msoFileDialogFolderPicker).Show If intResult <> 0 Then 'dispaly message box strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) End If Dim X As Long, FF As Long, S() As String ReDim S(1 To Selection.Rows.Count) For X = 1 To Selection.Rows.Count S(X) = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Selection.Rows(X).Value)), ";") Next FF = FreeFile FilePath = strPath & "\Data" & Format(Now(), "yyyyMMddhhmmss") & ".csv" Open FilePath For Output As #FF Print #FF, Join(S, vbNewLine) Close #FF Errhandler: ...Error Handling Code omitted End Sub
我需要能够复制单元格的确切格式。 将no-$单元格转换为$单元格将不起作用，因为没有使用$的值将被用于稍后可以处理逗号的过程中的计算，但不是$，而且我不能更改代码后面的计算（专有插件进行计算）。另外，行具有混合内容，这意味着行中的某些值是文本而不是数字。
我最终遵循了David Zemens的build议，并将For X = 1 to Selection.Rows.Count的部分修改For X = 1 to Selection.Rows.Count见下文。
For X = 1 To Selection.Rows.Count For Y = 1 To Selection.Columns.Count If Y <> Selection.Columns.Count Then If IsNumeric(temSheet.Cells(X + 1, Y).Value) Then If temSheet.Cells(X + 1, Y).Value = 0 Then S(X) = S(X) & ";" Else S(X) = S(X) & Replace(temSheet.Cells(X + 1, Y).Text, " ", "") & ";" End If Else S(X) = S(X) & Trim(temSheet.Cells(X + 1, Y).Text) & ";" End If Else If IsNumeric(temSheet.Cells(X + 1, Y).Value) Then If temSheet.Cells(X + 1, Y).Value <> 0 Then S(X) = S(X) & Replace(temSheet.Cells(X + 1, Y).Text, " ", "") End If Else S(X) = S(X) & Trim(temSheet.Cells(X + 1, Y).Text) End If End If Next Next
一些更多的格式是必要的。 它逐个单元格，有目的地跳过表单的第一行。 某些单元格的.Text属性在值之间或$和value之间返回空白空间，因此必须将其删除。 Trim会删除前导空格和结束空格，而Replacereplace导出中的所有空格。