如何简化下列录制代码

ad71631

Sub 汇入()

    With ActiveSheet.QueryTables.Add(Connection:=_      '<=修改成可以手动选择txt档案位置

        "TEXT;D: \TXT\原始TXT资料\01.txt", Destination:= _

        Range("A2"))

        .Name= "01_2"

        .FieldNames= True

        .RowNumbers= False

        .FillAdjacentFormulas= False

        .PreserveFormatting= True

        .RefreshOnFileOpen= False

        .RefreshStyle= xlInsertDeleteCells

        .SavePassword= False

        .SaveData= True

        .AdjustColumnWidth= True

        .RefreshPeriod= 0

        .TextFilePromptOnRefresh= False

        .TextFilePlatform= 950

        .TextFileStartRow= 1

        .TextFileParseType= xlFixedWidth

        .TextFileTextQualifier= xlTextQualifierDoubleQuote

        .TextFileConsecutiveDelimiter= False

        .TextFileTabDelimiter= True

        .TextFileSemicolonDelimiter= False

        .TextFileCommaDelimiter= False

        .TextFileSpaceDelimiter= False

        .TextFileColumnDataTypes= Array(2, 9, 2, 1, 1)

        .TextFileFixedColumnWidths = Array(6, 3, 10, 8)

        .TextFileTrailingMinusNumbers= True

        .RefreshBackgroundQuery:=False

    End With

    Range("A2:C22").Select  <=请帮我改成不论txt档案数据多寡,框线及字体与背景色,自动依照各txt资料笔数完成

    Range("C22").Activate

    With Selection.Font

        .Name= "Verdana"

        .Size= 9

        .Strikethrough= False

        .Superscript= False

        .Subscript= False

        .OutlineFont= False

        .Shadow= False

        .Underline= xlUnderlineStyleNone

        .ColorIndex= xlAutomatic

    End With

    Selection.Borders(xlDiagonalDown).LineStyle= xlNone

    Selection.Borders(xlDiagonalUp).LineStyle= xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle= xlContinuous

        .Weight= xlThin

        .ColorIndex= xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight= xlThin

        .ColorIndex= xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle= xlContinuous

        .Weight= xlThin

        .ColorIndex= xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle= xlContinuous

        .Weight= xlThin

        .ColorIndex= xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle= xlContinuous

        .Weight= xlHairline

        .ColorIndex= xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle= xlContinuous

        .Weight= xlHairline

        .ColorIndex= xlAutomatic

    End With

    With Selection.Interior

        .ColorIndex= 35

        .Pattern= xlSolid

    End With

End Sub

在此谢谢各位先进帮忙

hwc2ycy

1. Sub 汇入()
   
2.     Dim txtfile
   
3.     txtfile = Application.GetSaveAsFilename(ThisWorkbook.Path, "文本文件(*.txt),*.txt")
   
4.     If txtfile <> False Then
   
5.         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, Destination:= _
   
6.                                          Range("A2"))
   
7.             .Name = "01_2"
   
8.             .FieldNames = True
   
9.             .PreserveFormatting = True
   
10.             .SaveData = True
    
11.             .AdjustColumnWidth = True
    
12.             .RefreshPeriod = 0
    
13.             .TextFilePlatform = 950
    
14.             .TextFileStartRow = 1
    
15.             .TextFileParseType = xlFixedWidth
    
16.             .TextFileTextQualifier = xlTextQualifierDoubleQuote
    
17.             .TextFileTabDelimiter = True
    
18.             .TextFileColumnDataTypes = Array(2, 9, 2, 1, 1)
    
19.             .TextFileFixedColumnWidths = Array(6, 3, 10, 8)
    
20.             .TextFileTrailingMinusNumbers = True
    
21.         End With
    
22.         With Range("A2").CurrentRegion
    
23.             .Borders(xlDiagonalDown).LineStyle = xlNone
    
24.             .Borders(xlDiagonalUp).LineStyle = xlNone
    
25.             With .Borders
    
26.                 .LineStyle = xlContinuous
    
27.                 .Weight = xlThin
    
28.                 .ColorIndex = xlAutomatic
    
29.             End With
    
30.         End With
    
31.     Else
    
32.         MsgBox "请先选择要保存的TXT文件"
    
33.     End If
    
34. End Sub

复制代码

ad71631

谢谢你的帮忙
感谢

只是复制你修改的程序
只有A2有框线,其余A2~C65536无资料
麻烦你抽空修改看看
谢谢

ad71631

TXT数据内容为
A-1001,1,2013/03/0307:30:25
B-1002,1,2013/03/0307:33:41
A-1001,1,2013/03/0307:30:25
.
.
.
所以A1栏取  A-1001
所以B1栏取  2013/03/03  格式是”文字”
所以C1栏取  07:30:25      格式是”时间”