批量删除Excel文件空格提高效率

Sub mysub()
Dim ShApp As Object, mysheet As Object
Dim TF As Boolean, i As Integer
Dim aTable As Object, n As Integer
On Error Resume Next
n = 0
With Application.FileDialog(msoFileDialogFilePicker)
       .Title = "请选定要处理的excel文档"
       .Filters.Add "excel文档", "*.xlsx"
       .AllowMultiSelect = True
       If .Show <> -1 Then Exit Sub
       Set ShApp = GetObject(, "Excel.Application")
       If Err <> 0 Then
           TF = True
           Set ShApp = CreateObject("Excel.Application")
       End If
       Application.ScreenUpdating = False
       For i = 1 To .SelectedItems.Count
           Set mysheet = ShApp.Workbooks.Open(.SelectedItems(i))
                With mysheet.Sheets(1)
                    .Range("A4:A" & Range("a65536").End(3).Row)=""
                    .Range("A1")="层位"
                    .Range("b1")="层号"
                    .Range("c1")="顶深"
                    .Range("d1")="底深"
                    .Range("e1")="厚度"
                    .Range("f1")="地层电阻率"
                    .Range("g1")="声波时差"
                    .Range("h1")="孔隙度"
                    .Range("i1")="含油饱和度"