Excel VBA - 文本文件和文件夹操作实例集锦(3)

'山版主代码 运用数组及join函数一次转换连接成文本

arr = WorksheetFunction.Transpose(Range(Cells(3, \ '把当列数据(从第3行开始)保存到数组

ctxt = Join(arr, Chr(13) & Chr(10)) '连接为文本 Do While InStr(ctxt, \删除空格 ctxt = Replace(ctxt, \ Loop

Do While InStr(ctxt, Chr(13) & Chr(10) & Chr(13) & Chr(10)) > 0

ctxt = Replace(ctxt, Chr(13) & Chr(10) & Chr(13) & Chr(10), Chr(13) & Chr(10))

Loop

Open Filename For Output As #1

'Open cPath2(i, 1) & Replace(MyName, \打开文本文件

Print #1, ctxt '将数据一次写入文本文件 Close #1 '关闭文本文件 Next y

ActiveWorkbook.Close False Next x

Application.ScreenUpdating = True End Sub

10，文本数据逐行导入

（文本导入、不重复值、自定义格式、自定义条件格式）

‘http://club.excelhome.net/dispbbs.asp?boardID=2&ID=247693&page=1&px=0 ‘要生成的GB－LOAD样式.xls （自编宏之三） Dim Myr%, x%, n%, r1, Myc%, aa, bb, res, y% Dim Sht1 As Worksheet Dim Sht2 As Worksheet Sub sujcl() ' 数据处理

' 蓝桥玄霜 2007-6-20

Application.ScreenUpdating = False Set Sht1 = Sheets(1) Set Sht2 = Sheets(2) Sht1.Activate [a1].Select

Sht1.Cells.ClearContents Call ImportRange n = 2

Myr = [a65536].End(xlUp).Row Columns(\

Selection.TextToColumns Destination:=Range(\

FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(23, 1)), TrailingMinusNumbers:= _ True

Range(\

Selection.Cut Destination:=Range(\Call qukh ‘删除表1的空白行 Call fuz0619 ‘复制数据到表2 Application.ScreenUpdating = True End Sub

Sub ImportRange()

'引用自\入门与实战\Dim cell As Range

Dim Filename As String Dim x As Long, y As Integer Dim str As String, temp As String Dim Data As Variant Dim i As Integer

On Error Resume Next Set cell = ActiveCell

Filename = ThisWorkbook.Path & \Open Filename For Input As #1 If Err <> 0 Then

MsgBox \无法找到 \ Exit Sub End If x = 0 y = 0 str = \

Application.ScreenUpdating = False '忽略屏幕刷新 Do Until EOF(1)

Line Input #1, Data For i = 1 To Len(Data) temp = Mid(Data, i, 1) If temp = \

ActiveCell.Offset(x, y) = str y = y + 1 str = \

ElseIf i = Len(Data) Then

If temp <> Chr(34) Then str = str & temp ActiveCell.Offset(x, y) = str str = \