Question

我发现VBA代码几乎符合我将数据导出到CSV文件的要求。我遇到了分隔符功能问题。

我有以下功能：

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

将分隔符存储在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

设置分隔符以生成导出

3 个答案: