女朋友做会计工作,平时一堆重复性工作,给她在服务端写了代码跑一些重复性工作的内容。
最近有一个需求,她到处的是xlsl格式的excel,但是服务端读这种格式的文件,如果大于3M基本就报内存超了。。。
于是然她转csv,但是……她导出的csv又太多了……写了个vba脚本批量转csv,并且将特殊符号去除。主要避免excel中的部分单元格里面也有逗号,导致一些意外的问题。。。
第一次写,遇到的坑:
平时在mac里面搞,mac打开excel慢的一P,环境是一个坑。
写完脚本必须保存一下……搞了一上午,然后发现一直不起作用,下午才发现还需要保存一下,才能生效……
经验分享:
做会计和数据分析的朋友……去自定义宏,然后可以看宏的命令,改一改,然后基本就可以用了。。。。。
Sub SaveToCSVs()
Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
Dim a, i, j
'''下面第一个是EXCEL文件存放的地址,第二个是CSV要保存的地址,注意后面有一个 \
fPath = "D:\ada\test\"
sPath = "D:\ada\csv\"
fDir = Dir(fPath)
Do While (fDir <> "")
If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
On Error Resume Next
Set wB = Workbooks.Open(fPath & fDir)
'''MsgBox (wB.Name)
For Each wS In wB.Sheets
j = 0
'查了下一共36列,循环36次,如果表头为下面几个的,则去掉对应该列
For i = 1 To 36
If wS.Cells(1, i) = "联系人" Then
j = 1
wS.Columns(i).Delete Shift:=xlToLeft
End If
If wS.Cells(1, i) = "会员名称" Then
j = 1
wS.Columns(i).Delete Shift:=xlToLeft
End If
If wS.Cells(1, i) = "收货地址" Then
j = 1
wS.Columns(i).Delete Shift:=xlToLeft
End If
Next
'如果不存在上面几列则可能该excel有问题,先不转换为csv
If j = 1 Then
wS.SaveAs sPath & wB.Name & ".csv", xlCSV
Else
MsgBox (wB.Name & "表格可能存在问题")
End If
Next wS
wB.Close False
Set wB = Nothing
End If
fDir = Dir
On Error GoTo 0
Loop
End Sub