问题描述
我有一个带有数据选项卡的 .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