Question

我正在处理5张工作簿，其中工作表5上名为ExportCSV的按钮导出工作表3上的数据。更具体地说，该按钮运行一行一行的VBA代码并检查前3个单元格用于数据。如果前三个单元中的任何一个具有数据，则选择整行。选中所有包含数据的行后，数据将逐行写入CSV文件（但文件本身以分号分隔）。

我遇到的问题是正在复制某些单元格格式，但有些则不是。例如，使用$格式化为Accounting的单元格中的值格式正确，这意味着＆＃34; $ 12,345,678.90＆＃34;显示为＆＃34; $ 12,345,678.90。＆＃34;但是，格式为Accounting但没有$的单元格中的值未正确写入csv，这意味着＆＃34; 12,345,678.90＆＃34;正在编写为＆＃34; 12345678.9。＆＃34;

以下是有问题的宏。

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-$单元格转换为$ cells不会起作用，因为没有$的值将在稍后用于处理逗号但不是$的过程中进行计算，我无法更改稍后计算的代码（专有插件进行计算。）此外，行具有混合内容，这意味着行中的某些值是文本而不是数字。

Answer 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属性在值之前或$和值之间返回空格，因此必须将其删除。 Trim删除前导和结尾空格，而Replace替换导出中的所有空格。

Excel 2010 - 将格式化数字写入CSV的VBA代码

1 个答案: