Question

.SaveAs fileName：=＆＃34; name＆＃34; ＆安培; ＆＃34; .CSV＆＃34;，FileFormat：= xlCSV

以上是我用来保存excel为csv的内容。但是，在这个过程中我失去了所有的格式。例如，小数变为整数等。在excel vba中编写上述代码时，如何保留格式。

Answer 1

有关编写.csv文件而不是保存为一个文件的示例，请

以下是从第一个示例中提取的代码...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long

myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
    outStr = ""
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then
        outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
    Else
        outStr = outStr & myArr(iLoop, UBound(myArr, 2))
    End If
    Print #iFile, outStr
Next iLoop

Close iFile
Erase myArr

End Sub

修改以处理异常形状范围

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long
Dim lastCol As Long

' set up output file
myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1) ' loop through all rows
    outStr = ""
    lastCol = UBound(myArr, 2) ' find last column with data in it
    For jLoop = UBound(myArr, 2) To LBound(myArr, 2) Step -1
        If myArr(iLoop, jLoop) = "" Then
            lastCol = jLoop - 1
        Else
            Exit For
        End If
    Next jLoop
    For jLoop = LBound(myArr, 2) To lastCol - 1 ' loop until second last column
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then ' last column has no "," after it
        outStr = outStr & """" & myArr(iLoop, lastCol) & """"
    Else
        outStr = outStr & myArr(iLoop, lastCol)
    End If
    Print #iFile, outStr
Next iLoop

'clean up
Close iFile
Erase myArr

End Sub

将xls保存为csv时保留格式

1 个答案: