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
