Excel VBA_文本文件和文件夹操作实例集锦.doc
文本预览下载声明
1,导入文本数据(QueryTables)
‘110419.xls
Sub daorwb()
2008-4-19
Columns(a:g).ClearContents
‘文本文件名放在[y2]单元格,两文件在同一个文件夹
With ActiveSheet.QueryTables.Add(Connection:= _
TEXT; ThisWorkbook.Path \ [y2], Destination:=Range(A1))
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTabDelimiter = True
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
2,从文本文件中复制部分数据(OpenText方法)
‘/dispbbs.asp?BoardID=92ID=28958replyID=skin=1
Sub Macro1()
2007-10-18 (自编宏之四)
从文本文件中复制部分数据
‘Book1017.xls+test1017.txt
Application.DisplayAlerts = False
Dim Myflnm$
Myflnm = ThisWorkbook.Path \test1017.txt
Workbooks.OpenText Filename:=Myflnm, Origin _
:=xlWindows, StartRow:=37, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), TrailingMinusNumbers:=True
Selection.CurrentRegion.Copy
ThisWorkbook.Activate
[a1].Select
ActiveSheet.Paste
Windows(test1017.txt).Activate
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
3,超链接自动生成(Hyperlink公式中引用单元格)
Sub caolj1108()
‘超链接1108.xls (自编宏之四)
Dim Myr%, aa$, x%
Myr = [a65536].End(xlUp).Row
For x = 4 To Myr - 3
aa = Cells(x, 1)
If aa And InStr(aa, 小) = 0 And InStr(aa, 月) = 0 Then
Cells(x, n).Formula = =if(--(right(rc[-13],2))=50,mid(rc[-13],2,2)01-mid(rc[-13],2,2)50,mid(rc[-13],2,2)51-text(
显示全部