vba - Setting a delimiter to generate an export

Question

I found a VBA code that almost fits my requirements to export data to a CSV file. I am having problems with the delimiter function.

I have the following function:

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

This code is generating me something like that:

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

I need this function to generate the line skipping extra commas when there is no more characters to display at the end of each line.

I need this function to give me the following output (using the same data as the example given before:

a
d,,z
uo
u,,c
h

Thanks in advance for your help.

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

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