我发现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
提前感谢您的帮助。
答案 0 :(得分: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
答案 1 :(得分:0)
将分隔符存储在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
答案 2 :(得分:0)
换行:
'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