設置分隔符以生成導出

Question

我發現了一個幾乎符合我的要求將數據導出到CSV文件的VBA代碼。我遇到了分隔符函數的問題。

我有以下功能：

Function DelimitRange(ByVal XLArray As Variant) As String 
Const delimiter As String = "," 
Const lineFeed As String = vbCrLf 
Const removeExisitingDelimiter As Boolean = True  
Dim rowCount As Long 
Dim colCount As Long 
Dim tempString As String 


For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1) 
    For colCount = LBound(XLArray, 2) To UBound(XLArray, 2) 

     If removeExisitingDelimiter Then 
      tempString = tempString & Replace(XLArray(rowCount, colCount), delimiter, vbNullString) 
     Else 
      tempString = tempString & XLArray(rowCount, colCount) 
     End If 

     'Don't add delimiter to column end 
     If colCount < UBound(XLArray, 2) Then tempString = tempString & delimiter 

    Next colCount 

    'Add linefeed 
    If rowCount < UBound(XLArray, 1) Then tempString = tempString & lineFeed 

Next rowCount 

DelimitRange = tempString 

End Function 

此代碼生成我類似的東西：

a,,, 
d,,z, 
uo,,, 
u,,c, 
h,,, 

我需要這個功能來生成跳行額外的逗號時，有沒有更多的字符在每行的結尾顯示。

我需要這個功能給我下面的輸出（使用相同的數據作爲例子給出前：提前

a 
d,,z 
uo 
u,,c 
h 

感謝您的幫助

Answer 1

請參閱的currentItem在使用該代碼。根據下面的代碼修改代碼。

dim currentItem as string 

dim lastNonBlankIndex as Integer 
dim dataForTheRow 
dim stringifiedRow as string 

For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1) 
    redim dataForTheRow(LBound(XLArray, 2) To UBound(XLArray, 2)) 
    lastNonBlankIndex = LBound(XLArray, 2) 
    For colCount = LBound(XLArray, 2) To UBound(XLArray, 2) 

     If removeExisitingDelimiter Then 
      currentItem = Replace(XLArray(rowCount, colCount), delimiter, vbNullString) 
     Else 
      currentItem = XLArray(rowCount, colCount) 
     End If 
     dataForTheRow(colCount) = currentItem 

     If Trim(currentItem) <> "" Then 
      lastNonBlankIndex = colCount 
     End If 

    Next colCount 

    redim preserve dataForTheRow(LBound(XLArray, 2) To lastNonBlankIndex) 
    stringifiedRow = Join(dataForTheRow, delimiter) 

    Debug.Print stringifiedRow 

    'Add linefeed 
    tempString = tempString & stringifiedRow 
    If rowCount < UBound(XLArray, 1) Then 
     tempString = tempString & lineFeed 
    End If 

Next rowCount 

Answer 2

Store中的分隔符在delimitList和將它們連接起來只有索姆其他元素出現在同一行中。

請參閱下面的完整代碼：

Function DelimitRange(ByVal XLArray As Variant) As String 
    Const delimiter As String = "," 
    Const lineFeed As String = vbCrLf 
    Const removeExisitingDelimiter As Boolean = True 
    Dim rowCount As Long 
    Dim colCount As Long 
    Dim tempString As String 

    Dim delimitList As String 
    Dim currentItem As String 
    Dim tempSubString As String 

    For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1) 
     delimitList = "" 
     For colCount = LBound(XLArray, 2) To UBound(XLArray, 2) 
      currentItem = XLArray(rowCount, colCount) 
      If Trim(currentItem) <> "" Then 
       If tempSubString <> "" Then tempSubString = tempSubString & delimiter 
       tempSubString = tempSubString & delimitList 
       If removeExisitingDelimiter Then 
        tempSubString = tempSubString & Replace(currentItem, delimiter, vbNullString) 
       Else 
        tempSubString = tempSubString & currentItem 
       End If 
       delimitList = "" 
      Else 
       delimitList = delimitList & delimiter 
      End If 
     Next colCount 

     tempString = tempString & tempSubString 
     tempSubString = "" 

     'Add linefeed 
     If rowCount < UBound(XLArray, 1) Then tempString = tempString & lineFeed 
    Next rowCount 

    DelimitRange = tempString 

End Function 

Answer 3

換行變化：

'Add linefeed 
If rowCount < UBound(XLArray, 1) Then 
    While tempString Like "*" & delimiter 
      tempString=left(tempString, Len(tempstring)-len(delimiter)) 
    Wend 
    tempString = tempString & lineFeed 
End if