使用VBA批量CSV转XLS（97-2003）

 1 Sub EditCsvToXls()
 2 Application.ScreenUpdating = False
 3 '文件目录
 4 ChDir "C:\Users\QA-Department\Desktop\test"
 5 Dim sDir As String
 6 Dim curdir As String
 7 curdir = "C:\Users\QA-Department\Desktop\test"
 8 sDir = Dir(curdir & "\*.csv")
 9 While Len(sDir)
10 Workbooks.Open Filename:=curdir & "\" & sDir
11 '删除一些段落
12     Rows("1:7").Select
13     Selection.Delete Shift:=xlUp
14     Rows("193:197").Select
15     Selection.Delete Shift:=xlUp
16     Rows("373:377").Select
17     Selection.Delete Shift:=xlUp
18     Rows("618:618").Select
19     Selection.Delete Shift:=xlUp
20     Range("A1").Value = "???(MHz)"
21     Range("B1").Value = "???(dB)"
22     Columns("A:C").Select
23     Columns("A:C").EntireColumn.AutoFit
24 '损耗设置为正值
25     For i = 2 To 617
26          Range("B" & i).Value = Range("B" & i) * -1
27     Next i
28 '重命名表名
29     Sheets(1).Name = "sheet1"
30     Range("B2:B617").Select
31 '有效数字
32     Selection.NumberFormatLocal = "0.00"
33     Range("A1").Select
34 
35 Dim temp As String
36 temp = Left(sDir, Len(sDir) - 4)
37 ActiveWorkbook.SaveAs Filename:=curdir & "\" & temp & ".xls", _
38 FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
39 ReadOnlyRecommended:=False, CreateBackup:=False
40 ActiveWorkbook.Close
41 sDir = Dir
42 Wend
43 Application.ScreenUpdating = True
44 End Sub

 

转载于:https://www.cnblogs.com/sighful/p/10313000.html