2015-03-31 76 views
2

我正在处理5个工作表,其中工作表5上名为ExportCSV的按钮导出工作表3上的数据。更具体地说,该按钮运行一个VBA代码按行并检查前3个单元的数据。如果前三个单元格中的任何一个都有数据,则选择整行。在选择了所有包含数据的行之后,数据将逐行写入CSV文件(但文件本身是以分号分隔的)。Excel 2010 - 将格式化数字写入CSV的VBA代码

我遇到的问题是某些单元格格式正在被复制,但有些格式不是。例如,使用$格式化为Accounting的单元格中的值格式正确,意思是“$ 12,345,678.90”显示为“$ 12,345,678.90”。但是,格式为会计但没有$的单元格中的值不会正确写入csv,这意味着“12,345,678.90”正在写为“12345678.9”。

下面是有问题的宏。

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-$单元格转换为$单元格将不起作用,因为在可以处理逗号的过程中,以后没有使用$的值进行计算,但不能使用$,并且无法更改该代码后面的计算(专有插件进行计算)。另外,行具有混合内容,这意味着行中的某些值是文本而不是数字。

+0

您将需要大幅度改进'For x = 1到Selection.Rows.Count'循环。你将不得不对每个行范围的值数组进行逐个单元迭代,并更新数组以包含* formatted *值(默认情况下它会使用'.Value',它完全不了解任何格式)。那有意义吗?如果是的话,给它一个镜头,我们可以尝试帮助,如果你卡住了。 – 2015-03-31 21:43:08

+0

这确实有道理。我想我只是看到有没有人有任何想法不必这样做。 – 9Deuce 2015-03-31 21:44:46

+0

对,我认为当你处理*有条件时,还有另外一种方法*改变需要写入的值到现在你正在做的是从整个选择的行范围到数组的隐式转换,然后使用'Join'函数将该数组强制转换为字符串,以便将其写入FSO文件。那里的隐式转换将使用行中每个单元格的'.Value'。相反,您需要从单元格的“.Text”属性构建数组,该属性一次只能执行一个单元格/值,我认为。 – 2015-03-31 21:51:08

回答

1

我最终跟随了David Zemens的建议,并对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删除前导空格和结束空格,而Replace替换导出中的所有空格。

+0

干得好。如果性能是一个问题,您可以*首先*将整个行/范围'.Value'放入一个数组中,然后对其进行迭代,而不是逐个单元地迭代。它可能会更快,但在小数据集上可能不会显着。如果你有成千上万的行,我可能会这样做。 – 2015-04-01 17:32:32

+0

通常数据集不是那么大,但是我总共进行了一次测试,总共有2000个。选择大约需要5-10秒。出口是即时的。所以表现不应该是一个问题。感谢您的正确方向。 – 9Deuce 2015-04-01 17:36:26

+0

正确的导出应该是超级高效的,您正在使用优化的I/O函数一次打印整个文件。它只是需要一些时间的单元迭代,但大多数人可以忍受5-10秒,所以我不会大惊小怪,除非它成为未来的问题:)干杯。 – 2015-04-01 17:39:46