导出为没有格式化空白值的 CSV

问题描述

我有一个带有数据选项卡的 .xlsm,旨在用数据自动填充某些单元格,然后将这些行导出到 CSV 文件,但是当我运行我的代码时,它会复制整个活动范围,包括已格式化的单元格为空白并将它们导出为逗号,我尝试编写代码删除新 CSV 中的逗号,并且我尝试编写代码以首先不复制格式化的空白值,但到目前为止我什么都没有试过了。

到目前为止,我已经花了几个月的时间来解决这个问题,论坛上的其他人也遇到了同样的问题,但似乎没有人解决它。

Sub Mcam_Order_Entry()
'
' Mcam_Order_Entry Macro
' GETS ORDER ENTRY FORM READY FOR TRUnesT
'
' Keyboard Shortcut: Ctrl+Shift+M
'

Dim SB As Worksheet
Set SB = Worksheets("SandBox")
Set n = SB.Cells(3,2)
 

 Worksheets("PNM").copy
 With ActiveSheet.UsedRange
 .copy
 .PasteSpecial paste:=xlPasteValues,Operation:=xlNone,SkipBlanks _
        :=True,Transpose:=False
 End With
 Application.CutcopyMode = False
 ActiveWorkbook.SaveAs Filename:="I:\Group\DNC\MAGESTIC\Multicam\NEW MULTICAM DXFS\" & "nest" & n & ".csv",_
 FileFormat:=xlCSVMac
 
 ActiveWorkbook.RefreshAll
 Range("F15").Select
 ActiveWorkbook.Save
 ActiveWindow.Close
 Worksheets("SandBox").Select
 Range("B3") = Range("B3") + 1
 Worksheets("PNM").Select
 Range("F2:F15").Select
 Selection.ClearContents
 Range("F2").Select

End Sub

解决方法

试试,

Sub setRangToCsv()

    Dim Filename As String
    Dim rngDB As Range
    Dim Ws As Worksheet
    
    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange

    Filename = "comacsvtest.csv"
        
    TransToCSV Filename,rngDB

End Sub
Sub TransToCSV(myfile As String,rng As Range)

    Dim vDB,vR() As String,vTxt()
    Dim i As Long,n As Long,j As Integer,k As Integer
    Dim objStream
    Dim strFile As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB,1)
        n = n + 1
        k = 0
        Erase vR ' add  this  line
        For j = 1 To UBound(vDB,2)
            If vDB(i,j) <> "" Then
                k = k + 1
                ReDim Preserve vR(1 To k)
                vR(k) = vDB(i,j)
            End If
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR,",")
    Next i
    strtxt = Join(vTxt,vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strtxt
        .SaveToFile myfile,2
        .Close
    End With
    Set objStream = Nothing

End Sub