2015-03-31 102 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